From 18b972217015bb02eb4fe2389dd868b596c511de Mon Sep 17 00:00:00 2001 From: Alexis Montoison Date: Sat, 5 Sep 2026 22:16:23 -0600 Subject: [PATCH] Add C and Fortran interfaces --- .github/workflows/release-libsmc.yml | 237 +++ .github/workflows/test-libsmc.yml | 482 +++++ .gitignore | 3 + interfaces/README.md | 523 ++++++ interfaces/examples/C/basic_coloring.c | 149 ++ interfaces/examples/C/compress_decompress.c | 239 +++ interfaces/examples/C/symmetric_coloring.c | 129 ++ .../examples/Fortran/basic_coloring.f90 | 172 ++ .../examples/Fortran/compress_decompress.f90 | 270 +++ interfaces/include/smc.f90 | 502 +++++ interfaces/include/smc.h | 404 ++++ interfaces/scripts/coloring_table.jl | 217 +++ interfaces/scripts/generate_header.jl | 1130 ++++++++++++ interfaces/src/LibSMC.jl | 796 ++++++++ interfaces/src/c_enums.jl | 46 + interfaces/src/c_stores.jl | 792 ++++++++ interfaces/test/C/test_api.c | 646 +++++++ interfaces/test/C/test_coloring.c | 725 ++++++++ interfaces/test/Fortran/test_smc.f90 | 1621 +++++++++++++++++ interfaces/test/test_libsmc.jl | 1370 ++++++++++++++ test/static_compilation.jl | 7 +- 21 files changed, 10455 insertions(+), 5 deletions(-) create mode 100644 .github/workflows/release-libsmc.yml create mode 100644 .github/workflows/test-libsmc.yml create mode 100644 interfaces/README.md create mode 100644 interfaces/examples/C/basic_coloring.c create mode 100644 interfaces/examples/C/compress_decompress.c create mode 100644 interfaces/examples/C/symmetric_coloring.c create mode 100644 interfaces/examples/Fortran/basic_coloring.f90 create mode 100644 interfaces/examples/Fortran/compress_decompress.f90 create mode 100644 interfaces/include/smc.f90 create mode 100644 interfaces/include/smc.h create mode 100644 interfaces/scripts/coloring_table.jl create mode 100644 interfaces/scripts/generate_header.jl create mode 100644 interfaces/src/LibSMC.jl create mode 100644 interfaces/src/c_enums.jl create mode 100644 interfaces/src/c_stores.jl create mode 100644 interfaces/test/C/test_api.c create mode 100644 interfaces/test/C/test_coloring.c create mode 100644 interfaces/test/Fortran/test_smc.f90 create mode 100644 interfaces/test/test_libsmc.jl diff --git a/.github/workflows/release-libsmc.yml b/.github/workflows/release-libsmc.yml new file mode 100644 index 00000000..d69e5753 --- /dev/null +++ b/.github/workflows/release-libsmc.yml @@ -0,0 +1,237 @@ +name: Release libsmc binaries + +# Triggered by the version tag that TagBot pushes for each new release. +# Builds a self-contained libsmc bundle (library + Julia runtime) for all +# supported platforms and uploads the archives to the matching GitHub Release. +# +# We trigger on the tag push rather than on `release: published` because TagBot +# publishes the GitHub Release with the default GITHUB_TOKEN, and GitHub does not +# start new workflow runs from events emitted by GITHUB_TOKEN (anti-recursion). +# TagBot pushes the tag through the SSH DOCUMENTER_KEY instead, and deploy-key +# pushes DO trigger workflows (this is how Documentation.yml runs on release). +# +# workflow_dispatch lets you re-run or test against any existing tag. + +on: + push: + tags: + - 'v*' + + workflow_dispatch: + inputs: + tag: + description: 'Existing release tag to upload (like vX.Y.Z)' + required: true + +# Needed by `gh release upload`. +permissions: + contents: write + +jobs: + build: + name: ${{ matrix.label }} + runs-on: ${{ matrix.runner }} + container: ${{ matrix.container }} + + strategy: + fail-fast: false + + matrix: + include: + - label: linux-x86_64 + runner: ubuntu-22.04 + container: "" + juliac: juliac + lib: libsmc.so + libdir: lib + archive: libsmc-linux-x86_64.tar.gz + cpu_target: x86-64 + deployment_target: "" + + - label: linux-aarch64 + runner: ubuntu-22.04-arm + container: "" + juliac: juliac + lib: libsmc.so + libdir: lib + archive: libsmc-linux-aarch64.tar.gz + cpu_target: generic + deployment_target: "" + + - label: macos-arm64 + runner: macos-latest + container: "" + juliac: juliac + lib: libsmc.dylib + libdir: lib + archive: libsmc-macos-arm64.tar.gz + cpu_target: generic + deployment_target: "11.0" + + - label: macos-x86_64 + runner: macos-15-intel + container: "" + juliac: juliac + lib: libsmc.dylib + libdir: lib + archive: libsmc-macos-x86_64.tar.gz + cpu_target: x86-64 + deployment_target: "10.13" + + - label: windows-x86_64 + runner: windows-latest + container: "" + juliac: juliac.bat + lib: libsmc.dll + libdir: bin + archive: libsmc-windows-x86_64.zip + cpu_target: x86-64 + deployment_target: "" + + env: + MACOSX_DEPLOYMENT_TARGET: ${{ matrix.deployment_target }} + JULIA_CPU_TARGET: ${{ matrix.cpu_target }} + + steps: + - uses: actions/checkout@v7 + + - uses: julia-actions/setup-julia@v3 + with: + version: '1.12' + + # ----------------------------------------------------------------------- + # Install JuliaC.jl as a Julia app (provides the juliac CLI). The revision + # is pinned to the same one the test workflow uses, so what we ship is + # produced by exactly the toolchain that was tested. + # ----------------------------------------------------------------------- + - name: Install JuliaC.jl + shell: bash + run: | + julia --startup-file=no -e " + import Pkg + Pkg.Registry.add(\"General\") + Pkg.Apps.add(url=\"https://github.com/JuliaLang/JuliaC.jl\", rev=\"v0.3.8\") + " + + - name: Add juliac to PATH + shell: bash + run: | + JULIAC_BIN=$(julia --startup-file=no -e "print(joinpath(DEPOT_PATH[1], \"bin\"))") + echo "$JULIAC_BIN" >> "$GITHUB_PATH" + + # ----------------------------------------------------------------------- + # Show CPU information used for compilation + # ----------------------------------------------------------------------- + - name: Show CPU target + shell: bash + run: | + julia --startup-file=no -e ' + println("Sys.CPU_NAME = ", Sys.CPU_NAME) + println("JULIA_CPU_TARGET = ", get(ENV, "JULIA_CPU_TARGET", "")) + ' + + # ----------------------------------------------------------------------- + # Instantiate the SparseMatrixColorings.jl project. + # + # NOTE: unlike libkrylov there is deliberately no "strip SparseArrays" + # step. SMC is built on SparseMatrixCSC, so SparseArrays is load-bearing, + # not dead weight. SuiteSparse_jll therefore stays in the image and its + # dlopen'd libraries must be copied into the bundle by hand -- juliac + # cannot trace a dlopen. See the step after the build, and + # the note in interfaces/README.md. + # ----------------------------------------------------------------------- + - name: Instantiate Julia project + shell: bash + run: | + julia --startup-file=no --project=. -e " + import Pkg + Pkg.instantiate() + " + + # ----------------------------------------------------------------------- + # Build libsmc + # ----------------------------------------------------------------------- + - name: Build libsmc + shell: bash + run: | + OUTLIB="interfaces/build/${{ matrix.libdir }}/${{ matrix.lib }}" + mkdir -p "$(dirname "$OUTLIB")" + + ${{ matrix.juliac }} \ + --project . \ + --compile-ccallable \ + --trim=safe \ + --bundle interfaces/build \ + --output-lib "$OUTLIB" \ + interfaces/src/LibSMC.jl + + # ----------------------------------------------------------------------- + # Copy the SuiteSparse shared libraries into the bundle. SparseArrays + # pulls in SuiteSparse_jll, whose __init__ dlopens libamd & friends; + # juliac cannot trace a dlopen, so without this the shipped bundle aborts + # on the first call with a SuiteSparse_jll InitError. The destination is + # discovered from libjulia-internal so it works on Unix and Windows alike. + # ----------------------------------------------------------------------- + - name: Bundle SuiteSparse libraries + shell: bash + run: | + set -euo pipefail + DEST=$(dirname "$(find interfaces/build -name 'libjulia-internal.*' | head -n 1)") + [ -n "$DEST" ] || { echo "::error::could not locate the bundle's Julia library directory"; exit 1; } + BINDIR=$(julia --startup-file=no -e 'print(Sys.BINDIR)') + copied=0 + for name in amd btf camd ccolamd cholmod colamd klu ldl rbio spqr suitesparseconfig umfpack; do + for src in "$BINDIR"/../lib/julia "$BINDIR"/../lib "$BINDIR"; do + [ -d "$src" ] || continue + for f in "$src"/lib${name}.so* "$src"/lib${name}*.dylib "$src"/lib${name}*.dll; do + [ -e "$f" ] || continue + cp -a "$f" "$DEST/" && copied=$((copied + 1)) + done + done + done + echo "copied $copied SuiteSparse files into $DEST" + [ "$copied" -gt 0 ] || { echo "::error::no SuiteSparse libraries found; the bundle would abort at runtime"; exit 1; } + + # ----------------------------------------------------------------------- + # Generate smc.h and smc.f90 (one run emits both) + # ----------------------------------------------------------------------- + - name: Generate smc.h and smc.f90 + shell: bash + run: | + julia --startup-file=no --project=. \ + interfaces/scripts/generate_header.jl + + - name: Copy headers into bundle + shell: bash + run: | + mkdir -p interfaces/build/include + cp interfaces/include/smc.h interfaces/build/include/ + cp interfaces/include/smc.f90 interfaces/build/include/ + + # ----------------------------------------------------------------------- + # Package bundle + # ----------------------------------------------------------------------- + - name: Package bundle (Unix — tar.gz) + if: runner.os != 'Windows' + shell: bash + run: | + tar -czf "${{ matrix.archive }}" -C interfaces/build . + + - name: Package bundle (Windows — zip) + if: runner.os == 'Windows' + shell: pwsh + run: | + Compress-Archive ` + -Path interfaces/build/* ` + -DestinationPath "${{ matrix.archive }}" + + # ----------------------------------------------------------------------- + # Upload release asset + # ----------------------------------------------------------------------- + - name: Upload release asset + shell: bash + env: + GH_TOKEN: ${{ secrets.GITHUB_TOKEN }} + run: | + TAG="${{ github.event.inputs.tag || github.ref_name }}" + gh release upload "$TAG" "${{ matrix.archive }}" --clobber diff --git a/.github/workflows/test-libsmc.yml b/.github/workflows/test-libsmc.yml new file mode 100644 index 00000000..01b44aa2 --- /dev/null +++ b/.github/workflows/test-libsmc.yml @@ -0,0 +1,482 @@ +name: Test C and Fortran interfaces + +on: + push: + branches: + - main + paths: + - 'interfaces/**' + - 'src/**' + - 'Project.toml' + - '.github/workflows/test-libsmc.yml' + pull_request: + paths: + - 'interfaces/**' + - 'src/**' + - 'Project.toml' + - '.github/workflows/test-libsmc.yml' + +concurrency: + group: ${{ github.workflow }}-${{ github.ref }} + cancel-in-progress: ${{ startsWith(github.ref, 'refs/pull/') }} + +permissions: + contents: read + +jobs: + test: + name: ${{ matrix.label }} + runs-on: ${{ matrix.runner }} + strategy: + fail-fast: false + matrix: + include: + - label: linux-x86_64 + runner: ubuntu-latest + juliac: juliac + lib: libsmc.so + libdir: lib + + - label: linux-aarch64 + runner: ubuntu-24.04-arm + juliac: juliac + lib: libsmc.so + libdir: lib + + - label: macos-arm64 + runner: macos-latest + juliac: juliac + lib: libsmc.dylib + libdir: lib + + - label: macos-x86_64 + runner: macos-15-intel + juliac: juliac + lib: libsmc.dylib + libdir: lib + + - label: windows-x86_64 + runner: windows-latest + juliac: juliac.bat + lib: libsmc.dll + libdir: bin + + steps: + - uses: actions/checkout@v7 + + # ----------------------------------------------------------------------- + # The C (smc.h) and Fortran (smc.f90) headers each expose the + # SparseMatrixColorings.jl version as three integers (MAJOR/MINOR/PATCH). + # Verify the committed headers match Project.toml so a version bump can + # never ship with a stale header. Runs before any build step so it + # validates exactly what is committed. + # ----------------------------------------------------------------------- + - name: Check header versions match Project.toml + shell: bash + run: | + ver=$(grep -E '^version\s*=' Project.toml | head -1 | sed -E 's/.*"([^"]+)".*/\1/') + IFS=. read -r major minor patch <<< "$ver" + echo "Project.toml version: $ver (major=$major minor=$minor patch=$patch)" + fail=0 + check() { # check + grep -Fq "$2" "$1" || { echo "::error file=$1::expected '$2' (Project.toml is $ver)"; fail=1; } + } + check interfaces/include/smc.h "#define SMC_VERSION_MAJOR $major" + check interfaces/include/smc.h "#define SMC_VERSION_MINOR $minor" + check interfaces/include/smc.h "#define SMC_VERSION_PATCH $patch" + check interfaces/include/smc.f90 "SMC_VERSION_MAJOR = $major" + check interfaces/include/smc.f90 "SMC_VERSION_MINOR = $minor" + check interfaces/include/smc.f90 "SMC_VERSION_PATCH = $patch" + [ "$fail" -eq 0 ] && echo "Header versions match Project.toml ($ver)." + exit $fail + + - uses: julia-actions/setup-julia@v3 + with: + version: '1.12' + + # ----------------------------------------------------------------------- + # Install gfortran on macOS (not pre-installed on GitHub runners). + # The Linux and Windows runners already ship a usable gfortran. + # ----------------------------------------------------------------------- + - name: Install gfortran (macOS) + if: runner.os == 'macOS' + uses: fortran-lang/setup-fortran@main + with: + compiler: 'gcc' + version: '14' + + - name: Show gfortran version + shell: bash + run: gfortran --version + + # ----------------------------------------------------------------------- + # Install JuliaC.jl (provides the juliac CLI). The revision is pinned so a + # JuliaC release cannot silently change how the bundle is produced. + # ----------------------------------------------------------------------- + - name: Install JuliaC.jl + shell: bash + run: | + julia --startup-file=no -e " + import Pkg + Pkg.Registry.add(\"General\") + Pkg.Apps.add(url=\"https://github.com/JuliaLang/JuliaC.jl\", rev=\"v0.3.8\") + " + + - name: Add juliac to PATH + shell: bash + run: | + JULIAC_BIN=$(julia --startup-file=no -e "print(joinpath(DEPOT_PATH[1], \"bin\"))") + echo "$JULIAC_BIN" >> "$GITHUB_PATH" + + # ----------------------------------------------------------------------- + # Instantiate the SparseMatrixColorings.jl project. + # ----------------------------------------------------------------------- + - name: Instantiate Julia project + shell: bash + run: julia --startup-file=no --project=. -e "import Pkg; Pkg.instantiate()" + + # ----------------------------------------------------------------------- + # Compile libsmc with --bundle so the library is fully self-contained + # (Julia runtime bundled alongside) and dlopen works without any system + # Julia in PATH on all platforms. + # ----------------------------------------------------------------------- + - name: Build libsmc + shell: bash + run: | + OUTLIB="interfaces/build/${{ matrix.libdir }}/${{ matrix.lib }}" + mkdir -p "$(dirname "$OUTLIB")" + ${{ matrix.juliac }} \ + --project . \ + --compile-ccallable \ + --trim=safe \ + --bundle interfaces/build \ + --output-lib "$OUTLIB" \ + interfaces/src/LibSMC.jl + + # ----------------------------------------------------------------------- + # Copy the SuiteSparse shared libraries into the bundle. + # + # SparseArrays pulls in SuiteSparse_jll, whose __init__ dlopens libamd & + # friends. juliaC cannot trace a dlopen, so it leaves them out of the + # bundle and the library aborts on the very first call. We copy them next + # to the other bundled Julia shared libraries, which is already on + # libsmc's runpath. + # + # The destination is discovered from libjulia-internal rather than + # hardcoded, so this works for lib/julia (Unix) and bin (Windows) alike. + # ----------------------------------------------------------------------- + - name: Bundle SuiteSparse libraries + shell: bash + run: | + set -euo pipefail + DEST=$(dirname "$(find interfaces/build -name 'libjulia-internal.*' | head -n 1)") + [ -n "$DEST" ] || { echo "::error::could not locate the bundle's Julia library directory"; exit 1; } + BINDIR=$(julia --startup-file=no -e 'print(Sys.BINDIR)') + copied=0 + for name in amd btf camd ccolamd cholmod colamd klu ldl rbio spqr suitesparseconfig umfpack; do + for src in "$BINDIR"/../lib/julia "$BINDIR"/../lib "$BINDIR"; do + [ -d "$src" ] || continue + for f in "$src"/lib${name}.so* "$src"/lib${name}*.dylib "$src"/lib${name}*.dll; do + [ -e "$f" ] || continue + cp -a "$f" "$DEST/" && copied=$((copied + 1)) + done + done + done + echo "copied $copied SuiteSparse files into $DEST" + [ "$copied" -gt 0 ] || { echo "::error::no SuiteSparse libraries found; the bundle would abort at runtime"; exit 1; } + + # ----------------------------------------------------------------------- + # Regenerate the headers and fail if either differs from the committed + # copy, so neither can drift from function_sigs / coloring_table.jl. One + # generator run emits both smc.h and smc.f90, so both are checked. + # --ignore-cr-at-eol keeps this honest on Windows, where the checkout may + # have CRLF line endings while the generator writes LF. + # ----------------------------------------------------------------------- + - name: Generate smc.h / smc.f90 and check they are up to date + shell: bash + run: | + julia --startup-file=no --project=. interfaces/scripts/generate_header.jl + fail=0 + for f in interfaces/include/smc.h interfaces/include/smc.f90; do + if ! git ls-files --error-unmatch "$f" >/dev/null 2>&1; then + # An untracked file is invisible to `git diff`, so the check below + # would pass vacuously. Catch it explicitly. + echo "::error file=$f::$(basename "$f") is generated but not tracked by git; commit it" + fail=1 + elif ! git diff --exit-code --ignore-cr-at-eol -- "$f"; then + echo "::error file=$f::$(basename "$f") is out of date; regenerate it with 'julia --project=. interfaces/scripts/generate_header.jl' and commit the result" + fail=1 + fi + done + [ "$fail" -eq 0 ] && echo "interfaces/include/smc.h and interfaces/include/smc.f90 are up to date." + exit $fail + + # ----------------------------------------------------------------------- + # Verify the bundle is self-contained. + # Linux uses a dynamic check: run an example with ONLY the bundle on the + # library path (no system Julia), so a missing dlopen'd dependency makes it + # fail. macOS/Windows can't isolate reliably via env vars (SIP strips + # DYLD_*, Windows always searches system dirs), so they use a STATIC check + # that inspects the shipped binaries directly — see the steps below. + # ----------------------------------------------------------------------- + - name: Verify bundle is self-contained (Linux) + if: runner.os == 'Linux' + shell: bash + run: | + LIBPATH="$(pwd)/interfaces/build/${{ matrix.libdir }}" + gcc -O2 -o interfaces/build/selfcheck interfaces/examples/C/basic_coloring.c \ + -I interfaces/include "$LIBPATH/${{ matrix.lib }}" -lm + unset LD_LIBRARY_PATH + export LD_LIBRARY_PATH="$LIBPATH:$LIBPATH/julia" + interfaces/build/selfcheck + + # macOS: every dependency (otool -L) of the library and of each bundled + # dylib must resolve to something the bundle actually ships or to a genuine + # system lib. A loader-relative or bare dependency (@rpath/@loader_path/ + # @executable_path/, incl. a dylib's own install id) is fine only if a + # dylib of that name is present in the bundle; a /usr/lib or /System path is + # a system lib; any *other* absolute path (Homebrew, the runner's Julia + # depot) is a hardcoded external dependency and a leak. We do not inspect + # rpaths: a stray rpath is harmless unless a dependency needs it, which the + # resolution check below already catches. + - name: Verify bundle is self-contained (macOS) + if: runner.os == 'macOS' + shell: bash + run: | + set -uo pipefail + BUNDLE="interfaces/build" + find "$BUNDLE" -name '*.dylib' -exec basename {} \; | sort -u > bundled.txt + : > leaks.txt + { find "$BUNDLE" -name '*.dylib' + echo "$BUNDLE/${{ matrix.libdir }}/${{ matrix.lib }}"; } | while IFS= read -r lib; do + [ -f "$lib" ] || continue + # Dependencies (skip line 1: the file header "path:"). + otool -L "$lib" | tail -n +2 | awk '{print $1}' | while IFS= read -r dep; do + case "$dep" in + ""|/usr/lib/*|/System/*) continue ;; # system / empty + /*) echo "LEAK abspath: $(basename "$lib") -> $dep" | tee -a leaks.txt; continue ;; + esac + # loader-relative or bare name: must be shipped in the bundle + grep -Fqx "$(basename "$dep")" bundled.txt \ + || echo "LEAK unbundled: $(basename "$lib") -> $dep" | tee -a leaks.txt + done + done + if [ -s leaks.txt ]; then + echo "::error::macOS bundle is NOT self-contained"; sort -u leaks.txt; exit 1 + fi + echo "macOS bundle is self-contained" + + # Windows: every import (objdump -p) of every bundled DLL must resolve to + # another bundled DLL, a Windows API set (api-ms-win-*/ext-ms-*), or a real + # system DLL in System32. Anything else would be picked up from the runner's + # Julia install and is a leaked external dependency. + - name: Verify bundle is self-contained (Windows) + if: runner.os == 'Windows' + shell: bash + run: | + set -uo pipefail + BUNDLE="interfaces/build" + SYS="/c/Windows/System32" + : > leaks.txt + find "$BUNDLE" -iname '*.dll' -printf '%f\n' | tr '[:upper:]' '[:lower:]' | sort -u > bundled.txt + find "$BUNDLE" -iname '*.dll' | while IFS= read -r dll; do + objdump -p "$dll" 2>/dev/null | grep 'DLL Name:' | sed 's/.*DLL Name: *//' | tr -d '\r' | while IFS= read -r dep; do + depl="$(echo "$dep" | tr '[:upper:]' '[:lower:]')" + case "$depl" in + api-ms-win-*|ext-ms-*) continue ;; + esac + grep -qx "$depl" bundled.txt && continue + { [ -f "$SYS/$dep" ] || [ -f "$SYS/$depl" ]; } && continue + echo "LEAK: $(basename "$dll") -> $dep" | tee -a leaks.txt + done + done + if [ -s leaks.txt ]; then + echo "::error::Windows bundle is NOT self-contained"; sort -u leaks.txt; exit 1 + fi + echo "Windows bundle is self-contained" + + # ----------------------------------------------------------------------- + # Run the Julia test suite (all supported combos x orders x precisions). + # Loads LibSMC.jl as a plain Julia module — no dlopen of libsmc.so. + # Loading a juliac-compiled lib from within Julia would trigger a second + # runtime via ijl_adopt_thread and crash; the C tests cover the compiled + # library from native processes. + # ----------------------------------------------------------------------- + - name: Run Julia tests + shell: bash + run: | + julia --startup-file=no --project=. interfaces/test/test_libsmc.jl + + # ----------------------------------------------------------------------- + # C tests and examples. Each program returns a non-zero exit status on + # failure, so running it under `shell: bash` (-e) is the assertion. + # ----------------------------------------------------------------------- + + # ---- C test: API behaviour (ABI layout, enums, options, error codes) ---- + - name: Build C test (API behaviour) + shell: bash + run: | + LIBPATH="$(pwd)/interfaces/build/${{ matrix.libdir }}" + # -lm is implicit on Windows (CRT), harmless flag on Linux/macOS + gcc -O2 -o interfaces/build/test_api_c \ + interfaces/test/C/test_api.c \ + -I interfaces/include \ + "$LIBPATH/${{ matrix.lib }}" \ + -lm + + - name: Run C test (API behaviour) + shell: bash + run: | + LIBPATH="$(pwd)/interfaces/build/${{ matrix.libdir }}" + export PATH="$LIBPATH:$PATH" + export LD_LIBRARY_PATH="$LIBPATH:${LD_LIBRARY_PATH:-}" + export DYLD_LIBRARY_PATH="$LIBPATH:${DYLD_LIBRARY_PATH:-}" + interfaces/build/test_api_c + + # ---- C test: coloring (all combos, orders, groups, round-trips) ---- + - name: Build C test (coloring) + shell: bash + run: | + LIBPATH="$(pwd)/interfaces/build/${{ matrix.libdir }}" + gcc -O2 -o interfaces/build/test_coloring_c \ + interfaces/test/C/test_coloring.c \ + -I interfaces/include \ + "$LIBPATH/${{ matrix.lib }}" \ + -lm + + - name: Run C test (coloring) + shell: bash + run: | + LIBPATH="$(pwd)/interfaces/build/${{ matrix.libdir }}" + export PATH="$LIBPATH:$PATH" + export LD_LIBRARY_PATH="$LIBPATH:${LD_LIBRARY_PATH:-}" + export DYLD_LIBRARY_PATH="$LIBPATH:${DYLD_LIBRARY_PATH:-}" + interfaces/build/test_coloring_c + + # ---- C example: basic coloring ---- + - name: Build C example (basic coloring) + shell: bash + run: | + LIBPATH="$(pwd)/interfaces/build/${{ matrix.libdir }}" + gcc -O2 -o interfaces/build/basic_coloring \ + interfaces/examples/C/basic_coloring.c \ + -I interfaces/include \ + "$LIBPATH/${{ matrix.lib }}" \ + -lm + + - name: Run C example (basic coloring) + shell: bash + run: | + LIBPATH="$(pwd)/interfaces/build/${{ matrix.libdir }}" + export PATH="$LIBPATH:$PATH" + export LD_LIBRARY_PATH="$LIBPATH:${LD_LIBRARY_PATH:-}" + export DYLD_LIBRARY_PATH="$LIBPATH:${DYLD_LIBRARY_PATH:-}" + interfaces/build/basic_coloring + + # ---- C example: compress / decompress round-trip ---- + - name: Build C example (compress/decompress) + shell: bash + run: | + LIBPATH="$(pwd)/interfaces/build/${{ matrix.libdir }}" + gcc -O2 -o interfaces/build/compress_decompress \ + interfaces/examples/C/compress_decompress.c \ + -I interfaces/include \ + "$LIBPATH/${{ matrix.lib }}" \ + -lm + + - name: Run C example (compress/decompress) + shell: bash + run: | + LIBPATH="$(pwd)/interfaces/build/${{ matrix.libdir }}" + export PATH="$LIBPATH:$PATH" + export LD_LIBRARY_PATH="$LIBPATH:${LD_LIBRARY_PATH:-}" + export DYLD_LIBRARY_PATH="$LIBPATH:${DYLD_LIBRARY_PATH:-}" + interfaces/build/compress_decompress + + # ---- C example: symmetric coloring ---- + - name: Build C example (symmetric coloring) + shell: bash + run: | + LIBPATH="$(pwd)/interfaces/build/${{ matrix.libdir }}" + gcc -O2 -o interfaces/build/symmetric_coloring \ + interfaces/examples/C/symmetric_coloring.c \ + -I interfaces/include \ + "$LIBPATH/${{ matrix.lib }}" \ + -lm + + - name: Run C example (symmetric coloring) + shell: bash + run: | + LIBPATH="$(pwd)/interfaces/build/${{ matrix.libdir }}" + export PATH="$LIBPATH:$PATH" + export LD_LIBRARY_PATH="$LIBPATH:${LD_LIBRARY_PATH:-}" + export DYLD_LIBRARY_PATH="$LIBPATH:${DYLD_LIBRARY_PATH:-}" + interfaces/build/symmetric_coloring + + # ----------------------------------------------------------------------- + # Fortran tests and examples. smc.f90 is an include file, not a module, + # so there is nothing to compile ahead of time: -I interfaces/include is + # all gfortran needs to resolve `include 'smc.f90'`. As with the C + # programs, a non-zero exit status is the assertion. + # ----------------------------------------------------------------------- + + # ---- Fortran test: mirrors the C tests through the Fortran binding ---- + - name: Build Fortran test + shell: bash + run: | + LIBPATH="$(pwd)/interfaces/build/${{ matrix.libdir }}" + gfortran -O2 -o interfaces/build/test_smc_fortran \ + interfaces/test/Fortran/test_smc.f90 \ + -I interfaces/include \ + "$LIBPATH/${{ matrix.lib }}" + + - name: Run Fortran test + shell: bash + run: | + LIBPATH="$(pwd)/interfaces/build/${{ matrix.libdir }}" + export PATH="$LIBPATH:$PATH" + export LD_LIBRARY_PATH="$LIBPATH:${LD_LIBRARY_PATH:-}" + export DYLD_LIBRARY_PATH="$LIBPATH:${DYLD_LIBRARY_PATH:-}" + # gfortran block-buffers stdout when it is a pipe, so a program that + # dies loses the tail of its log and the failure looks like it + # happened earlier than it did -- which is exactly how the Windows + # trim() crash first presented. Unbuffered, the last line printed is + # the real one. Set SMC_TEST_VERBOSE=1 as well to echo every check. + export GFORTRAN_UNBUFFERED_ALL=1 + interfaces/build/test_smc_fortran + + # ---- Fortran examples: every .f90 in interfaces/examples/Fortran ---- + # Globbed rather than listed one step per file so adding an example needs + # no workflow edit; an empty directory is an error, not a silent pass. + - name: Build Fortran examples + shell: bash + run: | + LIBPATH="$(pwd)/interfaces/build/${{ matrix.libdir }}" + shopt -s nullglob + srcs=(interfaces/examples/Fortran/*.f90) + [ "${#srcs[@]}" -gt 0 ] || { echo "::error::no Fortran examples found in interfaces/examples/Fortran"; exit 1; } + for src in "${srcs[@]}"; do + name=$(basename "$src" .f90) + echo "building $src" + gfortran -O2 -o "interfaces/build/${name}_fortran" \ + "$src" \ + -I interfaces/include \ + "$LIBPATH/${{ matrix.lib }}" + done + + - name: Run Fortran examples + shell: bash + run: | + LIBPATH="$(pwd)/interfaces/build/${{ matrix.libdir }}" + export PATH="$LIBPATH:$PATH" + export LD_LIBRARY_PATH="$LIBPATH:${LD_LIBRARY_PATH:-}" + export DYLD_LIBRARY_PATH="$LIBPATH:${DYLD_LIBRARY_PATH:-}" + export GFORTRAN_UNBUFFERED_ALL=1 + shopt -s nullglob + srcs=(interfaces/examples/Fortran/*.f90) + [ "${#srcs[@]}" -gt 0 ] || { echo "::error::no Fortran examples found in interfaces/examples/Fortran"; exit 1; } + for src in "${srcs[@]}"; do + name=$(basename "$src" .f90) + echo "== running $name" + "interfaces/build/${name}_fortran" + done diff --git a/.gitignore b/.gitignore index 3f80bca8..04d17a00 100644 --- a/.gitignore +++ b/.gitignore @@ -19,6 +19,9 @@ deps/downloads/ deps/usr/ deps/src/ +# libsmc bundle produced by juliaC +interfaces/build/ + # Build artifacts for creating documentation generated by the Documenter package docs/build/ docs/site/ diff --git a/interfaces/README.md b/interfaces/README.md new file mode 100644 index 00000000..ea46652b --- /dev/null +++ b/interfaces/README.md @@ -0,0 +1,523 @@ +# C and Fortran interfaces for SparseMatrixColorings.jl + +Exposes [SparseMatrixColorings.jl](https://github.com/JuliaDiff/SparseMatrixColorings.jl) (SMC) as a +native shared library (`libsmc.so` / `libsmc.dylib` / `libsmc.dll`) callable from C, Fortran, and any +language with a C FFI. + +Two bindings ship with the library: the C header [`include/smc.h`](include/smc.h) and the Fortran +include file [`include/smc.f90`](include/smc.f90) (see [Calling from Fortran](#calling-from-fortran)). + +## Why + +The library is built with [`juliac`](https://github.com/JuliaLang/JuliaC.jl) and `--trim=safe`, which +statically compiles the Julia code and bundles the Julia runtime next to it, giving a relocatable +directory that runs on a machine with no Julia: + +``` +interfaces/build/ +├── lib/ (bin/ on Windows) +│ ├── libsmc.so ← the library +│ └── julia/ ← embedded Julia runtime (no system Julia needed) +└── include/ + ├── smc.h ← C header + └── smc.f90 ← Fortran include file +``` + +## Prerequisites + +| Tool | Version | +|------|---------| +| Julia | ≥ 1.12 | +| [JuliaC.jl](https://github.com/JuliaLang/JuliaC.jl) | 0.3.8 (the version pinned by CI) | +| C compiler | gcc or clang (MSVC/MinGW on Windows) | +| Fortran compiler *(only to call it from Fortran)* | any Fortran 2003 compiler with `iso_c_binding` | + +```bash +# Install JuliaC.jl once (installs juliac into ~/.julia/bin) +julia --startup-file=no -e 'import Pkg; Pkg.Registry.add("General"); Pkg.Apps.add(url="https://github.com/JuliaLang/JuliaC.jl", rev="v0.3.8")' +export PATH="$HOME/.julia/bin:$PATH" +``` + +## Build + +All commands run from the root of the SparseMatrixColorings.jl repository. + +```bash +julia --startup-file=no --project=. -e 'import Pkg; Pkg.instantiate()' +``` + +### Linux + +```bash +mkdir -p interfaces/build/lib +juliac \ + --project . \ + --compile-ccallable \ + --trim=safe \ + --bundle interfaces/build \ + --output-lib interfaces/build/lib/libsmc.so \ + interfaces/src/LibSMC.jl + +# One run emits both interfaces/include/smc.h and interfaces/include/smc.f90 +julia --startup-file=no --project=. interfaces/scripts/generate_header.jl +mkdir -p interfaces/build/include +cp interfaces/include/smc.h interfaces/include/smc.f90 interfaces/build/include/ +``` + +### macOS + +```bash +mkdir -p interfaces/build/lib +juliac \ + --project . \ + --compile-ccallable \ + --trim=safe \ + --bundle interfaces/build \ + --output-lib interfaces/build/lib/libsmc.dylib \ + interfaces/src/LibSMC.jl + +julia --startup-file=no --project=. interfaces/scripts/generate_header.jl +mkdir -p interfaces/build/include +cp interfaces/include/smc.h interfaces/include/smc.f90 interfaces/build/include/ +``` + +### Windows (Git Bash / MSYS shell) + +On Windows the bundle lands in `build/bin/` and the CLI is `juliac.bat`: + +```bash +mkdir -p interfaces/build/bin +juliac.bat \ + --project . \ + --compile-ccallable \ + --trim=safe \ + --bundle interfaces/build \ + --output-lib interfaces/build/bin/libsmc.dll \ + interfaces/src/LibSMC.jl + +julia --startup-file=no --project=. interfaces/scripts/generate_header.jl +mkdir -p interfaces/build/include +cp interfaces/include/smc.h interfaces/include/smc.f90 interfaces/build/include/ +``` + +> **Note.** The SuiteSparse libraries must be copied into the bundle by hand: `SparseArrays` pulls in +> `SuiteSparse_jll`, whose `__init__` `dlopen`s them, and `juliac` cannot trace a `dlopen`. Skip this +> and the first call aborts with +> `Core.InitError(mod=:SuiteSparse_jll, could not load library "libamd.so.3")`. +> +> ```bash +> JLIB="$(julia --startup-file=no -e 'print(joinpath(Sys.BINDIR, Base.LIBDIR, "julia"))')" +> cp -a "$JLIB"/lib{amd,btf,camd,ccolamd,cholmod,colamd,klu,ldl,rbio,spqr,suitesparseconfig,umfpack}.so* \ +> interfaces/build/lib/julia/ +> ``` +> +> (`.dylib` on macOS; on Windows the DLLs sit next to `julia.exe` and go into the bundle's `bin`.) +> CI does this in its "Bundle SuiteSparse libraries" step. + +## Running the tests and examples + +Set `LIBPATH` once; it is `interfaces/build/lib` everywhere except Windows, where it is +`interfaces/build/bin`. + +```bash +LIBPATH="$(pwd)/interfaces/build/lib" # Windows: .../interfaces/build/bin +``` + +### Julia tests + +`interfaces/test/test_libsmc.jl` `include`s `interfaces/src/LibSMC.jl` as a plain Julia module, so it +needs no build. It must **not** `dlopen` the compiled library: that would start a second Julia +runtime inside the first and crash. + +```bash +julia --startup-file=no --project=. interfaces/test/test_libsmc.jl +``` + +### C tests + +```bash +gcc -O2 -o interfaces/build/test_api_c \ + interfaces/test/C/test_api.c \ + -I interfaces/include "$LIBPATH/libsmc.so" -lm + +gcc -O2 -o interfaces/build/test_coloring_c \ + interfaces/test/C/test_coloring.c \ + -I interfaces/include "$LIBPATH/libsmc.so" -lm +``` + +### Fortran tests + +`smc.f90` is an *include file*, not a module, so `-I interfaces/include` is all `gfortran` needs and +no `.mod` file is produced or consumed. + +```bash +gfortran -O2 -o interfaces/build/test_smc_fortran \ + interfaces/test/Fortran/test_smc.f90 \ + -I interfaces/include "$LIBPATH/libsmc.so" +``` + +### Examples + +```bash +gcc -O2 -o interfaces/build/basic_coloring \ + interfaces/examples/C/basic_coloring.c \ + -I interfaces/include "$LIBPATH/libsmc.so" + +gcc -O2 -o interfaces/build/compress_decompress \ + interfaces/examples/C/compress_decompress.c \ + -I interfaces/include "$LIBPATH/libsmc.so" -lm + +gcc -O2 -o interfaces/build/symmetric_coloring \ + interfaces/examples/C/symmetric_coloring.c \ + -I interfaces/include "$LIBPATH/libsmc.so" +``` + +The Fortran examples all build the same way: + +```bash +for src in interfaces/examples/Fortran/*.f90; do + name=$(basename "$src" .f90) + gfortran -O2 -o "interfaces/build/${name}_fortran" \ + "$src" -I interfaces/include "$LIBPATH/libsmc.so" +done +``` + +On macOS replace `libsmc.so` with `libsmc.dylib`; on Windows with `libsmc.dll`. This holds for +`gfortran` too. + +### Running + +The loader must find `libsmc` *and* the bundled Julia runtime in `$LIBPATH/julia`. The dependency on +`julia/` is recorded in the library's own runpath, so putting `$LIBPATH` on the search path is +enough. Windows has no rpath — use `PATH`. + +```bash +# Linux +export LD_LIBRARY_PATH="$LIBPATH:${LD_LIBRARY_PATH:-}" + +# macOS +export DYLD_LIBRARY_PATH="$LIBPATH:${DYLD_LIBRARY_PATH:-}" + +# Windows (Git Bash) +export PATH="$LIBPATH:$PATH" +``` + +```bash +# Linux +gcc -O2 -o interfaces/build/basic_coloring \ + interfaces/examples/C/basic_coloring.c \ + -I interfaces/build/include interfaces/build/lib/libsmc.so \ + -Wl,-rpath,'$ORIGIN/lib' + +gfortran -O2 -o interfaces/build/basic_coloring_fortran \ + interfaces/examples/Fortran/basic_coloring.f90 \ + -I interfaces/build/include interfaces/build/lib/libsmc.so \ + -Wl,-rpath,'$ORIGIN/lib' + +# macOS ($ORIGIN is spelled @loader_path) +clang -O2 -o interfaces/build/basic_coloring \ + interfaces/examples/C/basic_coloring.c \ + -I interfaces/build/include interfaces/build/lib/libsmc.dylib \ + -Wl,-rpath,@loader_path/lib +``` + +## Hello world (C) + +```c +/* hello_smc.c — color a 4x4 tridiagonal matrix, no handle, no allocation. */ +#include +#include "smc.h" + +int main(void) +{ + /* CSC, 0-based: column j is colptr[j] .. colptr[j+1]-1 */ + const int colptr[5] = { 0, 2, 5, 8, 10 }; + const int rowval[10] = { 0, 1, 0, 1, 2, 1, 2, 3, 2, 3 }; + + SmcColoringOptions opts = smc_default_options(); /* nonsymmetric / column / direct */ + + int colors[4], ncolors; + int ret = smc_fast_coloring(4, 4, colptr, rowval, &opts, + NULL, /* row colors: only needed for SMC_BIDIRECTIONAL */ + colors, &ncolors); + if (ret != 0) { fprintf(stderr, "smc_fast_coloring failed (%d)\n", ret); return 1; } + + printf("ncolors = %d, colors =", ncolors); /* ncolors = 3, colors = 1 2 3 1 */ + for (int j = 0; j < 4; j++) printf(" %d", colors[j]); + printf("\n"); + return 0; +} +``` + +```bash +gcc -O2 -o hello_smc hello_smc.c -I interfaces/include "$LIBPATH/libsmc.so" +LD_LIBRARY_PATH="$LIBPATH" ./hello_smc +``` + +`smc_fast_coloring` is the stateless shortcut. When you also need groups, compression or +decompression, use `smc_coloring`, which returns an opaque handle to be released with +`smc_result_free`; see `examples/C/compress_decompress.c`. + +## Calling from Fortran + +`include/smc.f90` is the Fortran binding: the `SmcColoringOptions` derived type, the enumerators, +`SMC_VERSION_*` as `integer(c_int), parameter`, and an `interface` block declaring all 19 entry +points. It is **generated from the same table as `smc.h`**, so the two can never disagree. + +It is an *include file* and not a module because a module would force us to ship a `.mod` file, and +`.mod` files are compiler- and version-specific (a gfortran 13 `.mod` is unreadable by ifx, or by +gfortran 9). Put `include 'smc.f90'` at the top of the specification part, after `implicit none` — +the type must be defined before you declare a variable of it: + +```fortran +program my_prog + use iso_c_binding + implicit none + include 'smc.f90' ! <- here, after implicit none + + type(SmcColoringOptions), target :: opts + ... +end program my_prog +``` + +### Hello world (Fortran) + +```fortran +! hello_smc.f90 — color a 4x4 tridiagonal matrix, no handle, no allocation. +program hello_smc + use iso_c_binding + implicit none + include 'smc.f90' + + ! CSC, 0-based: column j holds rowval(colptr(j)+1 .. colptr(j+1)) + integer(c_int), target :: colptr(5) = [0, 2, 5, 8, 10] + integer(c_int), target :: rowval(10) = [0, 1, 0, 1, 2, 1, 2, 3, 2, 3] + integer(c_int), target :: colors(4), ncolors + type(SmcColoringOptions), target :: opts + integer(c_int) :: ret + + opts = smc_default_options() ! nonsymmetric / column / direct + + ret = smc_fast_coloring(4, 4, c_loc(colptr), c_loc(rowval), c_loc(opts), & + c_null_ptr, & ! row colors: only for SMC_BIDIRECTIONAL + c_loc(colors), c_loc(ncolors)) + if (ret /= 0) then + print '(a,i0,a)', 'smc_fast_coloring failed (', ret, ')' + stop 1 + end if + + print '(a,i0,a,4i2)', 'ncolors = ', ncolors, ', colors =', colors +end program hello_smc +``` + +```bash +gfortran -O2 -o hello_smc hello_smc.f90 -I interfaces/include "$LIBPATH/libsmc.so" +LD_LIBRARY_PATH="$LIBPATH" ./hello_smc # ncolors = 3, colors = 1 2 3 1 +``` + +`-I` points the compiler at the directory holding `smc.f90` (`interfaces/include`, or +`interfaces/build/include` in an unpacked bundle). Platform handling is exactly as for C: + +```bash +gfortran -O2 -o interfaces/build/hello_smc hello_smc.f90 \ + -I interfaces/build/include interfaces/build/lib/libsmc.so \ + -Wl,-rpath,'$ORIGIN/lib' # macOS: -Wl,-rpath,@loader_path/lib +``` + +### The `c_loc` convention + +Every C pointer is bound as `type(c_ptr), value`, so the caller passes `c_loc(x)` — and **`x` must +carry the `target` attribute**. Where C accepts `NULL`, pass `c_null_ptr`. The single exception is +the `void **result_out` of `smc_coloring`, an *out*-parameter, declared `type(c_ptr), intent(out)` +and passed as a bare `type(c_ptr)` variable: + +```fortran +type(c_ptr) :: res +ret = smc_coloring(m, n, c_loc(colptr), c_loc(rowval), c_loc(opts), res) ! no c_loc on res +... +ret = smc_result_free(res) +``` + +The full mapping: + +| C | Fortran | at the call site | +|---|---|---| +| `int` | `integer(c_int), value` | a literal such as `4`, or an `integer(c_int)` variable | +| `size_t` | `integer(c_size_t), value` | `int(nnz, c_size_t)`, `0_c_size_t` | +| `int *`, `const int *` | `type(c_ptr), value` | `c_loc(colptr)` | +| `void *`, `const void *` | `type(c_ptr), value` | `c_loc(Bc)` or `c_null_ptr` | +| `void **` (out) | `type(c_ptr), intent(out)` | a plain `type(c_ptr)` variable | +| `const SmcColoringOptions *` | `type(c_ptr), value` | `c_loc(opts)` or `c_null_ptr` | +| returns `int` | `function ... result(ret)`, `integer(c_int) :: ret` | `ret = smc_...(...)` | +| returns `void` | `subroutine` | `call smc_version(...)` | +| returns `SmcColoringOptions` | `function ... result(opts)`, by value | `opts = smc_default_options()` | + +Integer literals pass as `integer(c_int)` because the default integer kind is `c_int` — do not build +your program with `-fdefault-integer-8`, or declare the argument explicitly. + +Scalar out-parameters are `int *` like any other pointer, so they too go through `c_loc` of a +`target` scalar — except `smc_version`, whose three outputs are plain `intent(out)` scalars: + +```fortran +integer(c_int), target :: nc, m, n +integer(c_int) :: major, minor, patch ! no `target` needed + +call smc_version(major, minor, patch) +ret = smc_ncolors(res, c_loc(nc)) +ret = smc_size(res, c_loc(m), c_loc(n)) +``` + +### Index base + +`opts%index_base` defaults to **0**, the C convention. Fortran callers will usually want: + +```fortran +opts = smc_default_options() +opts%index_base = 1 +``` + +One setting covers both directions: it makes `colptr` and `rowval` 1-based *and* makes the group +members returned by `smc_column_group` / `smc_row_group` 1-based. Your arrays are never mutated. +Color *labels* are not indices and are never shifted: they are always `1..ncolors`, with `0` reserved +for "needs no evaluation" (only possible when `opts%postprocessing` is 1). + +### Buffers + +Dense buffers are column-major, already Fortran's layout, so a rank-2 array is handed over directly +with `c_loc` and no transpose. Buffer lengths are element counts, never bytes; the `size_t` ones need +an explicit kind, `int(Bc_rows * Bc_cols, c_size_t)`. For a non-bidirectional result `Br` is unused — +pass `c_null_ptr` with `0_c_size_t`: + +```fortran +ret = smc_compress(res, c_loc(nzval), int(nnz, c_size_t), & + c_null_ptr, 0_c_size_t, & + c_loc(Bc), int(Bc_rows * Bc_cols, c_size_t)) +``` + +Worked programs: `examples/Fortran/basic_coloring.f90` and +`examples/Fortran/compress_decompress.f90`. + +## Buffers and sizing + +Every buffer is caller-allocated, and **every buffer is passed with its length**. Lengths are +*element counts*, never bytes — elements of the type selected by `opts.dtype` at coloring time +(`double` for `SMC_FLOAT64`, `float` for `SMC_FLOAT32`). A buffer shorter than its required minimum +is rejected with `-3` before a single element is read or written, which is what makes it safe to +reuse a handle with a different set of buffers. A length of `0` is legitimate. + +Every one of those minimums can be queried from the handle alone: + +| buffer | passed to | minimum length | query | +|---|---|---|---| +| `colors` | `smc_column_colors` / `smc_row_colors` | `n` / `m` | `smc_size` | +| `members` | `smc_column_group` / `smc_row_group` | the group size | `smc_column_group_size` / `smc_row_group_size` | +| `nzval` | `smc_compress` | `nnz` | `smc_nnz` | +| `Bc` | `smc_compress` / `smc_decompress` | `Bc_rows * Bc_cols` | `smc_compressed_size` | +| `Br` | `smc_compress` / `smc_decompress` | `Br_rows * Br_cols`, `0` unless bidirectional | `smc_compressed_size` | +| `A_out` | `smc_decompress` | `m * n` | `smc_size` | + +The two queries that describe the pattern the result was built from: + +```c +/* Number of stored entries; exactly the length nzval must have. */ +int smc_nnz(void *result, int *nnz_out); + +/* Dimensions of the pattern; A_out must hold m*n elements. */ +int smc_size(void *result, int *m_out, int *n_out); +``` + +The compression entry points take one length per buffer, immediately after it: + +```c +int smc_compress(void *result, + const void *nzval, size_t nzval_len, + void *Br, size_t Br_len, + void *Bc, size_t Bc_len); + +int smc_decompress(void *result, + const void *Br, size_t Br_len, + const void *Bc, size_t Bc_len, + void *A_out, size_t A_len); +``` + +A result is bidirectional exactly when `Br_cols > 0`. Otherwise `Br` is unused: pass `NULL` with +`Br_len` 0. A bidirectional result needs both `Br` and `Bc`, and a `NULL` for either is `-3`. In +outline: + +```c +int nnz, m, n, Br_rows, Br_cols, Bc_rows, Bc_cols; +smc_nnz(result, &nnz); +smc_size(result, &m, &n); +smc_compressed_size(result, &Br_rows, &Br_cols, &Bc_rows, &Bc_cols); + +size_t Bc_len = (size_t)Bc_rows * (size_t)Bc_cols; +size_t A_len = (size_t)m * (size_t)n; /* m*n overflows a 32-bit int */ +double *Bc = malloc(Bc_len * sizeof(double)); +double *A = malloc(A_len * sizeof(double)); + +smc_compress(result, nzval, (size_t)nnz, NULL, 0, Bc, Bc_len); +smc_decompress(result, NULL, 0, Bc, Bc_len, A, A_len); +``` + +The color and group buffer lengths stay `int`, being bounded by `m` or `n`. The numerical buffers use +`size_t` because `m*n` overflows a 32-bit `int` at perfectly ordinary dimensions (`m = n = 50000` +already gives 2.5e9). `examples/C/compress_decompress.c` is the worked version of the sketch above. + +## Return codes + +Every entry point returns an `int`: + +| code | meaning | +|-----:|---------| +| `0` | success | +| `-1` | internal error (a Julia exception was caught and logged) | +| `-2` | unsupported combination of `(structure, partition, decompression, dtype)` | +| `-3` | invalid argument (NULL pointer, bad dimension, buffer too small, bad enum, bad `index_base`) | +| `-4` | invalid or already-freed handle | + +Use-after-free and double-free of a handle return `-4` instead of crashing. + +## Regenerating the headers + +`include/smc.h` and `include/smc.f90` are both generated by a single run of the same script from a +single signature table. Both are committed and checked by CI (`git diff --exit-code` after a +regeneration, plus a check that the `SMC_VERSION_*` values match `Project.toml`). Never edit either +by hand — edit `interfaces/scripts/coloring_table.jl` or the signature table in +`interfaces/src/LibSMC.jl`, then: + +```bash +julia --startup-file=no --project=. interfaces/scripts/generate_header.jl +git diff interfaces/include/smc.h interfaces/include/smc.f90 +``` + +## Limitations + +- **Only 6 combinations of `(structure, partition, decompression)` are supported**; anything else + returns `-2`. + + | structure | partition | decompression | dtype | + |---|---|---|---| + | `SMC_NONSYMMETRIC` | `SMC_COLUMN` | `SMC_DIRECT` | both | + | `SMC_NONSYMMETRIC` | `SMC_ROW` | `SMC_DIRECT` | both | + | `SMC_NONSYMMETRIC` | `SMC_BIDIRECTIONAL` | `SMC_DIRECT` | `SMC_FLOAT64`, `SMC_FLOAT32` | + | `SMC_NONSYMMETRIC` | `SMC_BIDIRECTIONAL` | `SMC_SUBSTITUTION` | `SMC_FLOAT64`, `SMC_FLOAT32` | + | `SMC_SYMMETRIC` | `SMC_COLUMN` | `SMC_DIRECT` | both | + | `SMC_SYMMETRIC` | `SMC_COLUMN` | `SMC_SUBSTITUTION` | `SMC_FLOAT64`, `SMC_FLOAT32` | + + In particular `(SMC_NONSYMMETRIC, SMC_COLUMN or SMC_ROW, SMC_SUBSTITUTION)` is not a valid SMC + problem, and symmetric problems only exist with the column partition. +- **`RandomOrder` is not exposed.** It carries an `AbstractRNG`, which is untested under `--trim`. + The five deterministic orders of `SmcOrder` are available. +- **Indices are 32-bit `int`.** They are widened to `Int64` internally, but matrices with more than + 2^31 stored entries are out of scope. Use `opts.index_base` to choose 0- or 1-based `colptr` / + `rowval` (default 0); the caller's arrays are never mutated. +- **Values are `double` or `float` only** (`SmcDataType`); no complex, no `BigFloat`. Coloring itself + is structure-only, so `dtype` matters only for compression / decompression. +- **Dense buffers are column-major** (`B[i,j] == B[i + j*ld]`), matching Julia and Fortran. +- **CPU only.** SMC's GPU support lives in Julia package extensions, which are not compiled into the + library. +- **The Fortran binding is an include file, not a module**, so every pointer argument is a + `type(c_ptr)` you fill with `c_loc(...)` rather than an assumed-shape array; see + [Calling from Fortran](#calling-from-fortran). +- **The bundle is large (~275 MB)**: `libsmc` itself is only about 5 MB, but the bundle embeds the + Julia runtime, OpenBLAS, and the SuiteSparse libraries that `SparseArrays` loads at startup. diff --git a/interfaces/examples/C/basic_coloring.c b/interfaces/examples/C/basic_coloring.c new file mode 100644 index 00000000..6ca95ff0 --- /dev/null +++ b/interfaces/examples/C/basic_coloring.c @@ -0,0 +1,149 @@ +/* + * basic_coloring.c — minimal example: color the columns of a sparse matrix. + * + * A is the 6x6 tridiagonal matrix tridiag(-1, 2, -1). Two columns may share a + * color only if they have no nonzero in a common row. Only the sparsity + * pattern is used; see compress_decompress.c for the numerical values. + * + * Compile (after building libsmc with juliac — see interfaces/README.md): + * + * gcc -o interfaces/build/basic_coloring interfaces/examples/C/basic_coloring.c \ + * -I interfaces/build/include \ + * interfaces/build/lib/libsmc.so \ + * -Wl,-rpath,'$ORIGIN/lib' + * + * The rpath assumes the binary sits in interfaces/build/, next to lib/; on + * macOS use -Wl,-rpath,@loader_path/lib instead. + * + * Expected output: + * SparseMatrixColorings 0.4.x + * ncolors = 3 + * column colors = [ 1 2 3 1 2 3 ] + * group 1 = { 0 3 } + * group 2 = { 1 4 } + * group 3 = { 2 5 } + */ + +#include +#include + +#include "smc.h" + +/* A = tridiag(-1, 2, -1), 6x6, compressed sparse column. With the default + * opts.index_base == 0 both colptr and rowval are 0-based: column j occupies + * entries colptr[j] .. colptr[j+1] - 1, and rowval[k] is the row of entry k. */ + +#define M 6 +#define N 6 +#define NNZ 16 + +static const int colptr[N + 1] = { 0, 2, 5, 8, 11, 14, 16 }; +static const int rowval[NNZ] = { 0, 1, + 0, 1, 2, + 1, 2, 3, + 2, 3, 4, + 3, 4, 5, + 4, 5 }; + +int main(void) +{ + int major, minor, patch; + smc_version(&major, &minor, &patch); + printf("SparseMatrixColorings %d.%d.%d\n", major, minor, patch); + + /* Defaults: nonsymmetric / column / direct / natural, 0-based, Float64. */ + SmcColoringOptions opts = smc_default_options(); + + /* The result is an opaque handle owned by the library; it must be released + with smc_result_free(). */ + void *result = NULL; + int ret = smc_coloring(M, N, colptr, rowval, &opts, &result); + if (ret != 0) { + fprintf(stderr, "smc_coloring failed (%d)\n", ret); + return 1; + } + + int nc = 0; + ret = smc_ncolors(result, &nc); + if (ret != 0) { + fprintf(stderr, "smc_ncolors failed (%d)\n", ret); + smc_result_free(result); + return 1; + } + printf("ncolors = %d\n", nc); + + /* Colors are labels in 1..ncolors, not indices: they are never shifted by + opts.index_base. The value 0 is the neutral color and appears only when + opts.postprocessing is enabled. The buffer must hold at least n entries. */ + int *colors = (int *)malloc(sizeof(int) * N); + if (colors == NULL) { + fprintf(stderr, "out of memory\n"); + smc_result_free(result); + return 1; + } + + ret = smc_column_colors(result, colors, N); + if (ret != 0) { + fprintf(stderr, "smc_column_colors failed (%d)\n", ret); + free(colors); + smc_result_free(result); + return 1; + } + + printf("column colors = ["); + for (int j = 0; j < N; j++) + printf(" %d", colors[j]); + printf(" ]\n"); + + /* The same coloring seen as groups of columns sharing a color. Group indices + run over 1..ncolumn_groups; the members are column indices in the caller's + index base. Sizes are queried first to size the buffer exactly. */ + int ngroups = 0; + ret = smc_ncolumn_groups(result, &ngroups); + if (ret != 0) { + fprintf(stderr, "smc_ncolumn_groups failed (%d)\n", ret); + free(colors); + smc_result_free(result); + return 1; + } + + for (int g = 1; g <= ngroups; g++) { + int size = 0; + if (smc_column_group_size(result, g, &size) != 0) { + fprintf(stderr, "smc_column_group_size failed for group %d\n", g); + free(colors); + smc_result_free(result); + return 1; + } + + int *members = (int *)malloc(sizeof(int) * (size > 0 ? size : 1)); + if (members == NULL) { + fprintf(stderr, "out of memory\n"); + free(colors); + smc_result_free(result); + return 1; + } + + if (smc_column_group(result, g, members, size) != 0) { + fprintf(stderr, "smc_column_group failed for group %d\n", g); + free(members); + free(colors); + smc_result_free(result); + return 1; + } + + printf("group %d = {", g); + for (int k = 0; k < size; k++) + printf(" %d", members[k]); + printf(" }\n"); + + free(members); + } + + /* Using the handle after this returns -4 rather than crashing, and freeing + twice is safe. */ + free(colors); + smc_result_free(result); + + return 0; +} diff --git a/interfaces/examples/C/compress_decompress.c b/interfaces/examples/C/compress_decompress.c new file mode 100644 index 00000000..488e7675 --- /dev/null +++ b/interfaces/examples/C/compress_decompress.c @@ -0,0 +1,239 @@ +/* + * compress_decompress.c — the full round trip: color, compress, decompress. + * + * 1. color the columns of the sparsity pattern of A (smc_coloring) + * 2. evaluate one directional derivative per color; stacking them + * side by side gives the compressed matrix B = A * S (smc_compress) + * 3. scatter B back into the sparse structure of A (smc_decompress) + * + * Step 2 is done here by the library itself, which lets us check that + * decompress(compress(A)) == A. A = tridiag(-1, 2, -1), 6x6, needs 3 colors. + * + * Every numerical buffer is passed with its length in elements, and every such + * length can be queried from the handle before allocating: + * + * nzval : smc_nnz -> nnz elements + * Br, Bc : smc_compressed_size -> Br_rows*Br_cols, Bc_rows*Bc_cols elements + * A_out : smc_size -> m*n elements + * + * A buffer shorter than its minimum is rejected with -3 before a single element + * is read or written; the last section below demonstrates it. + * + * Compile (after building libsmc with juliac — see interfaces/README.md): + * + * gcc -o interfaces/build/compress_decompress \ + * interfaces/examples/C/compress_decompress.c \ + * -I interfaces/build/include \ + * interfaces/build/lib/libsmc.so \ + * -Wl,-rpath,'$ORIGIN/lib' -lm + * + * On macOS use -Wl,-rpath,@loader_path/lib instead. + * + * Expected output: + * ncolors = 3 + * pattern: 6 x 6, 16 stored entries + * compressed matrix B (6 x 3): + * 2.00 -1.00 0.00 + * -1.00 2.00 -1.00 + * -1.00 -1.00 2.00 + * 2.00 -1.00 -1.00 + * -1.00 2.00 -1.00 + * 0.00 -1.00 2.00 + * max error on the 16 stored entries: 0.000e+00 + * max leakage outside the pattern: 0.000e+00 + * short nzval -> -3, short Bc -> -3, short A_out -> -3 + */ + +#include +#include +#include + +#include "smc.h" + +/* A = tridiag(-1, 2, -1), 6x6, compressed sparse column, 0-based. nzval + * follows the same ordering as rowval: nzval[k] is the value at row rowval[k]. */ + +#define M 6 +#define N 6 +#define NNZ 16 + +static const int colptr[N + 1] = { 0, 2, 5, 8, 11, 14, 16 }; +static const int rowval[NNZ] = { 0, 1, + 0, 1, 2, + 1, 2, 3, + 2, 3, 4, + 3, 4, 5, + 4, 5 }; +static const double nzval[NNZ] = { 2.0, -1.0, + -1.0, 2.0, -1.0, + -1.0, 2.0, -1.0, + -1.0, 2.0, -1.0, + -1.0, 2.0, -1.0, + -1.0, 2.0 }; + +int main(void) +{ + /* Defaults: nonsymmetric / column / direct / natural, 0-based, Float64. + dtype fixes the element type of the compressed and decompressed buffers + below, and hence the unit of every *_len argument. */ + SmcColoringOptions opts = smc_default_options(); + + void *result = NULL; + int ret = smc_coloring(M, N, colptr, rowval, &opts, &result); + if (ret != 0) { + fprintf(stderr, "smc_coloring failed (%d)\n", ret); + return 1; + } + + int nc = 0; + if (smc_ncolors(result, &nc) != 0) { + fprintf(stderr, "smc_ncolors failed\n"); + smc_result_free(result); + return 1; + } + printf("ncolors = %d\n", nc); + + /* Ask the handle for every size we are about to allocate: the result + remembers the pattern it was built from, so a caller that only has the + handle can still size its buffers. */ + int nnz = 0; + ret = smc_nnz(result, &nnz); + if (ret != 0) { + fprintf(stderr, "smc_nnz failed (%d)\n", ret); + smc_result_free(result); + return 1; + } + + int m = 0, n = 0; + ret = smc_size(result, &m, &n); + if (ret != 0) { + fprintf(stderr, "smc_size failed (%d)\n", ret); + smc_result_free(result); + return 1; + } + printf("pattern: %d x %d, %d stored entries\n", m, n, nnz); + + if (m != M || n != N || nnz != NNZ) { + fprintf(stderr, "handle describes a different pattern\n"); + smc_result_free(result); + return 1; + } + + /* A bidirectional partition splits the compression into a row block Br and a + column block Bc. For the column partition used here only Bc is meaningful + and the Br dimensions come back as 0, so Br is passed as NULL with + length 0. A result is bidirectional exactly when Br_cols > 0. */ + int Br_rows = 0, Br_cols = 0, Bc_rows = 0, Bc_cols = 0; + ret = smc_compressed_size(result, &Br_rows, &Br_cols, &Bc_rows, &Bc_cols); + if (ret != 0) { + fprintf(stderr, "smc_compressed_size failed (%d)\n", ret); + smc_result_free(result); + return 1; + } + + /* Element counts are computed in size_t: m*n overflows a 32-bit int at + perfectly ordinary dimensions. */ + size_t Bc_len = (size_t)Bc_rows * (size_t)Bc_cols; + size_t A_len = (size_t)m * (size_t)n; + + double *Bc = (double *)calloc(Bc_len, sizeof(double)); + double *Ad = (double *)calloc(A_len, sizeof(double)); + if (Bc == NULL || Ad == NULL) { + fprintf(stderr, "out of memory\n"); + free(Bc); free(Ad); + smc_result_free(result); + return 1; + } + + /* Compress: B[:, c] = sum of the columns of A colored c. In a real AD code + this buffer would instead be filled by evaluating one directional + derivative per color. */ + ret = smc_compress(result, + nzval, (size_t)nnz, + NULL, 0, /* Br unused by a column partition */ + Bc, Bc_len); + if (ret != 0) { + fprintf(stderr, "smc_compress failed (%d)\n", ret); + free(Bc); free(Ad); + smc_result_free(result); + return 1; + } + + /* Dense buffers are column-major: B[i,j] lives at Bc[i + j*Bc_rows]. */ + printf("compressed matrix B (%d x %d):\n", Bc_rows, Bc_cols); + for (int i = 0; i < Bc_rows; i++) { + for (int j = 0; j < Bc_cols; j++) + printf(" %5.2f", Bc[i + j * Bc_rows]); + printf("\n"); + } + + /* Decompress: recover the full m-by-n dense A from B, again column-major. */ + ret = smc_decompress(result, + NULL, 0, /* Br unused by a column partition */ + Bc, Bc_len, + Ad, A_len); + if (ret != 0) { + fprintf(stderr, "smc_decompress failed (%d)\n", ret); + free(Bc); free(Ad); + smc_result_free(result); + return 1; + } + + /* Check that every stored entry came back exactly and that nothing leaked + into positions outside the sparsity pattern. */ + double max_err = 0.0; + char *in_pattern = (char *)calloc(A_len, sizeof(char)); + if (in_pattern == NULL) { + fprintf(stderr, "out of memory\n"); + free(Bc); free(Ad); + smc_result_free(result); + return 1; + } + + for (int j = 0; j < N; j++) { + for (int k = colptr[j]; k < colptr[j + 1]; k++) { + int i = rowval[k]; + in_pattern[i + j * M] = 1; + double err = fabs(Ad[i + j * M] - nzval[k]); + if (err > max_err) max_err = err; + } + } + printf("max error on the %d stored entries: %.3e\n", NNZ, max_err); + + double max_leak = 0.0; + for (int j = 0; j < N; j++) { + for (int i = 0; i < M; i++) { + if (!in_pattern[i + j * M]) { + double leak = fabs(Ad[i + j * M]); + if (leak > max_leak) max_leak = leak; + } + } + } + printf("max leakage outside the pattern: %.3e\n", max_leak); + + /* Understating any length is refused with -3, and nothing is read or written + before the refusal — the guarantee that lets a handle be reused safely. */ + int short_nzval = smc_compress(result, nzval, (size_t)nnz - 1, NULL, 0, Bc, Bc_len); + int short_Bc = smc_compress(result, nzval, (size_t)nnz, NULL, 0, Bc, Bc_len - 1); + int short_A = smc_decompress(result, NULL, 0, Bc, Bc_len, Ad, A_len - 1); + printf("short nzval -> %d, short Bc -> %d, short A_out -> %d\n", + short_nzval, short_Bc, short_A); + + free(in_pattern); + free(Bc); + free(Ad); + smc_result_free(result); + + /* Direct decompression is an exact scatter, so both errors must be zero. */ + if (max_err != 0.0 || max_leak != 0.0) { + fprintf(stderr, "round trip did not reproduce A\n"); + return 1; + } + + if (short_nzval != -3 || short_Bc != -3 || short_A != -3) { + fprintf(stderr, "a short buffer was not rejected\n"); + return 1; + } + + return 0; +} diff --git a/interfaces/examples/C/symmetric_coloring.c b/interfaces/examples/C/symmetric_coloring.c new file mode 100644 index 00000000..9ede6115 --- /dev/null +++ b/interfaces/examples/C/symmetric_coloring.c @@ -0,0 +1,129 @@ +/* + * symmetric_coloring.c — color a symmetric matrix (Hessian-style). + * + * A is the 2D 5-point Laplacian on a 4x4 grid: a 16x16 symmetric matrix. The + * difference with basic_coloring.c is opts.structure = SMC_SYMMETRIC, which + * exploits A[i,j] being readable from either column j or column i and so needs + * fewer colors. With SMC_DIRECT this is a star coloring: every entry is + * recovered by a plain copy, where SMC_SUBSTITUTION would solve instead. + * + * Compile (after building libsmc with juliac — see interfaces/README.md): + * + * gcc -o interfaces/build/symmetric_coloring \ + * interfaces/examples/C/symmetric_coloring.c \ + * -I interfaces/build/include \ + * interfaces/build/lib/libsmc.so \ + * -Wl,-rpath,'$ORIGIN/lib' + * + * On macOS use -Wl,-rpath,@loader_path/lib instead. + * + * Expected output: + * grid 4x4 -> n = 16, nnz = 64 + * ncolors = 5 + * color of each grid node: + * 1 2 1 3 + * 3 1 4 1 + * 1 5 1 2 + * 2 1 3 1 + */ + +#include +#include + +#include "smc.h" + +#define NX 4 /* grid points in x */ +#define NY 4 /* grid points in y */ +#define N (NX * NY) /* matrix order */ +#define MAX_NNZ (5 * N) /* at most 5 entries per column */ + +/* Node (i,j) of the grid, 0 <= i < NX, 0 <= j < NY, maps to column i + j*NX. */ +static int node(int i, int j) { return i + j * NX; } + +/* Build the 5-point Laplacian in CSC form (0-based), returning the number of + * stored entries. Column k holds k-NX, k-1, k, k+1, k+NX, already sorted in + * increasing order as CSC requires. */ +static int build_laplacian(int *colptr, int *rowval) +{ + int nnz = 0; + + for (int j = 0; j < NY; j++) { + for (int i = 0; i < NX; i++) { + int k = node(i, j); + colptr[k] = nnz; + + if (j > 0) rowval[nnz++] = node(i, j - 1); /* south */ + if (i > 0) rowval[nnz++] = node(i - 1, j); /* west */ + rowval[nnz++] = k; /* centre */ + if (i < NX - 1) rowval[nnz++] = node(i + 1, j); /* east */ + if (j < NY - 1) rowval[nnz++] = node(i, j + 1); /* north */ + } + } + colptr[N] = nnz; + + return nnz; +} + +int main(void) +{ + int colptr[N + 1]; + int rowval[MAX_NNZ]; + + int nnz = build_laplacian(colptr, rowval); + printf("grid %dx%d -> n = %d, nnz = %d\n", NX, NY, N, nnz); + + /* symmetric_pattern = 1 asserts that the pattern really is symmetric, letting + the library skip building the transposed pattern. It is trusted, not + checked, so only set it when it holds — as it does for a Laplacian. + The partition stays SMC_COLUMN: symmetric problems are colored by column. */ + SmcColoringOptions opts = smc_default_options(); + opts.structure = SMC_SYMMETRIC; + opts.partition = SMC_COLUMN; + opts.decompression = SMC_DIRECT; + opts.symmetric_pattern = 1; + + void *result = NULL; + int ret = smc_coloring(N, N, colptr, rowval, &opts, &result); + if (ret != 0) { + fprintf(stderr, "smc_coloring failed (%d)\n", ret); + return 1; + } + + int nc = 0; + ret = smc_ncolors(result, &nc); + if (ret != 0) { + fprintf(stderr, "smc_ncolors failed (%d)\n", ret); + smc_result_free(result); + return 1; + } + printf("ncolors = %d\n", nc); + + /* Printing the colors laid out on the grid makes the pattern visible. */ + int colors[N]; + ret = smc_column_colors(result, colors, N); + if (ret != 0) { + fprintf(stderr, "smc_column_colors failed (%d)\n", ret); + smc_result_free(result); + return 1; + } + + printf("color of each grid node:\n"); + for (int j = 0; j < NY; j++) { + printf(" "); + for (int i = 0; i < NX; i++) + printf(" %d", colors[node(i, j)]); + printf("\n"); + } + + smc_result_free(result); + + /* Sanity check: every color is a valid label in 1..ncolors. */ + for (int k = 0; k < N; k++) { + if (colors[k] < 1 || colors[k] > nc) { + fprintf(stderr, "column %d has out-of-range color %d\n", k, colors[k]); + return 1; + } + } + + return 0; +} diff --git a/interfaces/examples/Fortran/basic_coloring.f90 b/interfaces/examples/Fortran/basic_coloring.f90 new file mode 100644 index 00000000..74e8bcaa --- /dev/null +++ b/interfaces/examples/Fortran/basic_coloring.f90 @@ -0,0 +1,172 @@ +! basic_coloring.f90 — minimal example: color the columns of a sparse matrix. +! +! A is the 6x6 tridiagonal matrix tridiag(-1, 2, -1). Two columns may share a +! color only if they have no nonzero in a common row. Only the sparsity pattern +! is used; see compress_decompress.f90 for the numerical values. +! +! The Fortran counterpart of examples/C/basic_coloring.c, differing in that it +! sets opts%index_base = 1, so colptr, rowval and the group members returned by +! the queries are all 1-based. Color *labels* are never shifted by index_base. +! +! Compile (after building libsmc with juliac — see interfaces/README.md): +! +! gfortran -O2 -o interfaces/build/basic_coloring_f \ +! interfaces/examples/Fortran/basic_coloring.f90 \ +! -I interfaces/include \ +! interfaces/build/lib/libsmc.so \ +! -Wl,-rpath,'$ORIGIN/lib' +! +! -I points gfortran at the directory holding smc.f90, the include file below. +! On macOS use -Wl,-rpath,@loader_path/lib instead. +! +! Expected output: +! SparseMatrixColorings 0.4.x +! ncolors = 3 +! column colors = [ 1 2 3 1 2 3 ] +! group 1 = { 1 4 } +! group 2 = { 2 5 } +! group 3 = { 3 6 } +! +! Exit code: 0 on success, 1 if any call fails. + +program basic_coloring + use iso_c_binding + use iso_fortran_env, only: error_unit + implicit none + include 'smc.f90' ! <- must come after implicit none + + ! A = tridiag(-1, 2, -1), 6x6, compressed sparse column. With + ! opts%index_base == 1 both colptr and rowval are 1-based: column j occupies + ! entries colptr(j) .. colptr(j+1) - 1, and rowval(k) is the row of entry k. + ! + ! Every array whose address is handed to C through c_loc must carry the + ! target attribute. + + integer(c_int), parameter :: m = 6 ! number of rows + integer(c_int), parameter :: n = 6 ! number of columns + integer(c_int), parameter :: nnz = 16 ! number of stored entries + + integer(c_int), target :: colptr(n+1) = [ 1, 3, 6, 9, 12, 15, 17 ] + integer(c_int), target :: rowval(nnz) = [ 1, 2, & + 1, 2, 3, & + 2, 3, 4, & + 3, 4, 5, & + 4, 5, 6, & + 5, 6 ] + + type(SmcColoringOptions), target :: opts + + ! Scalars written by the library through an int* out-parameter, passed as + ! c_loc(...), so they too need target. + integer(c_int), target :: major, minor, patch + integer(c_int), target :: nc, ngroups, gsize + + integer(c_int), target :: colors(n) + integer(c_int), target, allocatable :: members(:) + + type(c_ptr) :: result ! opaque handle, owned by the library + integer(c_int) :: ret + integer :: g, j, k + + ! smc_version is the one void-returning entry point, hence a subroutine, and + ! the one whose int* outputs are bound as plain intent(out) scalars, so no + ! c_loc is needed here. + call smc_version(major, minor, patch) + write(*,'(A,I0,A,I0,A,I0)') "SparseMatrixColorings ", major, ".", minor, ".", patch + + ! Defaults: nonsymmetric / column / direct / natural, 0-based, Float64. + ! Always start from that call and override only what you need — here the index + ! base, so the CSC arrays above can be written the Fortran way. + opts = smc_default_options() + opts%index_base = 1 + + ! The result is an opaque handle owned by the library; it must be released + ! with smc_result_free(). result_out is the one argument not passed by value: + ! it is a void** out-parameter, declared type(c_ptr), intent(out), so `result` + ! is given bare rather than through c_loc. + result = c_null_ptr + ret = smc_coloring(m, n, c_loc(colptr), c_loc(rowval), c_loc(opts), result) + if (ret /= 0) then + write(error_unit,'(A,I0,A)') "smc_coloring failed (", ret, ")" + stop 1 + end if + + nc = 0 + ret = smc_ncolors(result, c_loc(nc)) + if (ret /= 0) then + write(error_unit,'(A,I0,A)') "smc_ncolors failed (", ret, ")" + ret = smc_result_free(result) + stop 1 + end if + write(*,'(A,I0)') "ncolors = ", nc + + ! The buffer must hold at least n entries; the length is checked before a + ! single element is written, so a short buffer is refused with -3 rather than + ! overrun. Colors are labels in 1..ncolors, not indices, and are never + ! shifted by opts%index_base. The value 0 is the neutral color and appears + ! only when opts%postprocessing is enabled. + ret = smc_column_colors(result, c_loc(colors), n) + if (ret /= 0) then + write(error_unit,'(A,I0,A)') "smc_column_colors failed (", ret, ")" + ret = smc_result_free(result) + stop 1 + end if + + write(*,'(A)', advance='no') "column colors = [" + do j = 1, n + write(*,'(A,I0)', advance='no') " ", colors(j) + end do + write(*,'(A)') " ]" + + ! The same coloring seen as groups of columns sharing a color. Group indices + ! run over 1..ncolumn_groups and are always 1-based whatever opts%index_base + ! says; the *members* are column indices in the caller's index base, so with + ! index_base = 1 they subscript a Fortran array directly. + ngroups = 0 + ret = smc_ncolumn_groups(result, c_loc(ngroups)) + if (ret /= 0) then + write(error_unit,'(A,I0,A)') "smc_ncolumn_groups failed (", ret, ")" + ret = smc_result_free(result) + stop 1 + end if + + do g = 1, ngroups + gsize = 0 + ret = smc_column_group_size(result, int(g, c_int), c_loc(gsize)) + if (ret /= 0) then + write(error_unit,'(A,I0,A,I0,A)') "smc_column_group_size failed for group ", g, & + " (", ret, ")" + ret = smc_result_free(result) + stop 1 + end if + + ! c_loc requires a nonzero-sized object, so never allocate 0 elements. + allocate(members(max(gsize, 1))) + + ret = smc_column_group(result, int(g, c_int), c_loc(members), gsize) + if (ret /= 0) then + write(error_unit,'(A,I0,A,I0,A)') "smc_column_group failed for group ", g, & + " (", ret, ")" + deallocate(members) + ret = smc_result_free(result) + stop 1 + end if + + write(*,'(A,I0,A)', advance='no') "group ", g, " = {" + do k = 1, gsize + write(*,'(A,I0)', advance='no') " ", members(k) + end do + write(*,'(A)') " }" + + deallocate(members) + end do + + ! Using the handle after this returns -4 rather than crashing, and freeing + ! twice is safe. + ret = smc_result_free(result) + if (ret /= 0) then + write(error_unit,'(A,I0,A)') "smc_result_free failed (", ret, ")" + stop 1 + end if + +end program basic_coloring diff --git a/interfaces/examples/Fortran/compress_decompress.f90 b/interfaces/examples/Fortran/compress_decompress.f90 new file mode 100644 index 00000000..16b8950b --- /dev/null +++ b/interfaces/examples/Fortran/compress_decompress.f90 @@ -0,0 +1,270 @@ +! compress_decompress.f90 — the full round trip: color, compress, decompress. +! +! 1. color the columns of the sparsity pattern of A (smc_coloring) +! 2. evaluate one directional derivative per color; stacking them +! side by side gives the compressed matrix B = A * S (smc_compress) +! 3. scatter B back into the sparse structure of A (smc_decompress) +! +! Step 2 is done here by the library itself, which lets us check that +! decompress(compress(A)) == A. A = tridiag(-1, 2, -1), 6x6, needs 3 colors. +! +! Every numerical buffer is passed with its length in elements, and every such +! length can be queried from the handle before allocating: +! +! nzval : smc_nnz -> nnz elements +! Br, Bc : smc_compressed_size -> Br_rows*Br_cols, Bc_rows*Bc_cols elements +! A_out : smc_size -> m*n elements +! +! A buffer shorter than its minimum is rejected with -3 before a single element +! is read or written; the last section below demonstrates it. +! +! Dense matrices crossing the interface are column-major, Fortran's own layout, +! so Bc and A below are plain 2D arrays handed over with a single c_loc. Like +! basic_coloring.f90 this sets opts%index_base = 1. +! +! Compile (after building libsmc with juliac — see interfaces/README.md): +! +! gfortran -O2 -o interfaces/build/compress_decompress_f \ +! interfaces/examples/Fortran/compress_decompress.f90 \ +! -I interfaces/include \ +! interfaces/build/lib/libsmc.so \ +! -Wl,-rpath,'$ORIGIN/lib' +! +! -I points gfortran at the directory holding smc.f90. On macOS use +! -Wl,-rpath,@loader_path/lib instead. +! +! Expected output: +! ncolors = 3 +! pattern: 6 x 6, 16 stored entries +! compressed matrix B (6 x 3): +! 2.00 -1.00 0.00 +! -1.00 2.00 -1.00 +! -1.00 -1.00 2.00 +! 2.00 -1.00 -1.00 +! -1.00 2.00 -1.00 +! 0.00 -1.00 2.00 +! max error on the 16 stored entries: 0.000E+00 +! max leakage outside the pattern: 0.000E+00 +! short nzval -> -3, short Bc -> -3, short A_out -> -3 +! +! Exit code: 0 on success, 1 if any call fails or the round trip is inexact. + +program compress_decompress + use iso_c_binding + use iso_fortran_env, only: error_unit + implicit none + include 'smc.f90' ! <- must come after implicit none + + ! A = tridiag(-1, 2, -1), 6x6, compressed sparse column, 1-based to match + ! opts%index_base = 1 below. nzval follows the same ordering as rowval: + ! nzval(k) is the value at row rowval(k), and only smc_compress reads it. + ! + ! All four arrays carry target, since their addresses are taken with c_loc. + + integer(c_int), parameter :: M_ROWS = 6 ! number of rows + integer(c_int), parameter :: N_COLS = 6 ! number of columns + integer(c_int), parameter :: NNZ = 16 ! number of stored entries + + integer(c_int), target :: colptr(N_COLS+1) = [ 1, 3, 6, 9, 12, 15, 17 ] + integer(c_int), target :: rowval(NNZ) = [ 1, 2, & + 1, 2, 3, & + 2, 3, 4, & + 3, 4, 5, & + 4, 5, 6, & + 5, 6 ] + real(c_double), target :: nzval(NNZ) = [ 2.0_c_double, -1.0_c_double, & + -1.0_c_double, 2.0_c_double, -1.0_c_double, & + -1.0_c_double, 2.0_c_double, -1.0_c_double, & + -1.0_c_double, 2.0_c_double, -1.0_c_double, & + -1.0_c_double, 2.0_c_double, -1.0_c_double, & + -1.0_c_double, 2.0_c_double ] + + type(SmcColoringOptions), target :: opts + + ! Scalars filled by the library through int* out-parameters. + integer(c_int), target :: nc, nnz_q, m, n + integer(c_int), target :: Br_rows, Br_cols, Bc_rows, Bc_cols + + real(c_double), target, allocatable :: Bc(:,:) ! compressed (Bc_rows x Bc_cols) + real(c_double), target, allocatable :: A(:,:) ! decompressed (m x n) + logical, allocatable :: in_pattern(:,:) + + ! Lengths are element counts, never bytes, and use c_size_t because m*n + ! overflows a 32-bit int at perfectly ordinary dimensions. + integer(c_size_t) :: nzval_len, Bc_len, A_len + + type(c_ptr) :: result + integer(c_int) :: ret, short_nzval, short_Bc, short_A + integer :: i, j, k + real(c_double) :: max_err, max_leak, err, leak + + ! Defaults: nonsymmetric / column / direct / natural, Float64; we switch the + ! index base to 1 for Fortran. dtype fixes the element type of the compressed + ! and decompressed buffers below, and hence the unit of every *_len argument. + opts = smc_default_options() + opts%index_base = 1 + + result = c_null_ptr + ret = smc_coloring(M_ROWS, N_COLS, c_loc(colptr), c_loc(rowval), c_loc(opts), result) + if (ret /= 0) then + write(error_unit,'(A,I0,A)') "smc_coloring failed (", ret, ")" + stop 1 + end if + + nc = 0 + ret = smc_ncolors(result, c_loc(nc)) + if (ret /= 0) then + write(error_unit,'(A,I0,A)') "smc_ncolors failed (", ret, ")" + ret = smc_result_free(result) + stop 1 + end if + write(*,'(A,I0)') "ncolors = ", nc + + ! Ask the handle for every size we are about to allocate: the result remembers + ! the pattern it was built from, so a caller that only has the handle can + ! still size its buffers. + nnz_q = 0 + ret = smc_nnz(result, c_loc(nnz_q)) + if (ret /= 0) then + write(error_unit,'(A,I0,A)') "smc_nnz failed (", ret, ")" + ret = smc_result_free(result) + stop 1 + end if + + m = 0 + n = 0 + ret = smc_size(result, c_loc(m), c_loc(n)) + if (ret /= 0) then + write(error_unit,'(A,I0,A)') "smc_size failed (", ret, ")" + ret = smc_result_free(result) + stop 1 + end if + write(*,'(A,I0,A,I0,A,I0,A)') "pattern: ", m, " x ", n, ", ", nnz_q, " stored entries" + + if (m /= M_ROWS .or. n /= N_COLS .or. nnz_q /= NNZ) then + write(error_unit,'(A)') "handle describes a different pattern" + ret = smc_result_free(result) + stop 1 + end if + + ! A bidirectional partition splits the compression into a row block Br and a + ! column block Bc. For the column partition used here only Bc is meaningful + ! and the Br dimensions come back as 0, so Br is passed as c_null_ptr with + ! length 0. A result is bidirectional exactly when Br_cols > 0. + Br_rows = 0 + Br_cols = 0 + Bc_rows = 0 + Bc_cols = 0 + ret = smc_compressed_size(result, c_loc(Br_rows), c_loc(Br_cols), & + c_loc(Bc_rows), c_loc(Bc_cols)) + if (ret /= 0) then + write(error_unit,'(A,I0,A)') "smc_compressed_size failed (", ret, ")" + ret = smc_result_free(result) + stop 1 + end if + + ! Allocate exactly what the queries reported. Fortran stores arrays + ! column-major, so a 2D array is already in the layout the library expects. + allocate(Bc(Bc_rows, Bc_cols)) + allocate(A(m, n)) + Bc = 0.0_c_double + A = 0.0_c_double + + nzval_len = int(nnz_q, c_size_t) + Bc_len = int(Bc_rows, c_size_t) * int(Bc_cols, c_size_t) + A_len = int(m, c_size_t) * int(n, c_size_t) + + ! Compress: B(:, c) = sum of the columns of A colored c. In a real AD code + ! this buffer would instead be filled by evaluating one directional derivative + ! per color. + ret = smc_compress(result, & + c_loc(nzval), nzval_len, & + c_null_ptr, 0_c_size_t, & ! Br unused by a column partition + c_loc(Bc), Bc_len) + if (ret /= 0) then + write(error_unit,'(A,I0,A)') "smc_compress failed (", ret, ")" + ret = smc_result_free(result) + stop 1 + end if + + write(*,'(A,I0,A,I0,A)') "compressed matrix B (", Bc_rows, " x ", Bc_cols, "):" + do i = 1, Bc_rows + do j = 1, Bc_cols + write(*,'(F7.2)', advance='no') Bc(i,j) + end do + write(*,*) + end do + + ! Decompress: recover the full m-by-n dense A from B. + ret = smc_decompress(result, & + c_null_ptr, 0_c_size_t, & ! Br unused by a column partition + c_loc(Bc), Bc_len, & + c_loc(A), A_len) + if (ret /= 0) then + write(error_unit,'(A,I0,A)') "smc_decompress failed (", ret, ")" + ret = smc_result_free(result) + stop 1 + end if + + ! Check that every stored entry came back exactly and that nothing leaked into + ! positions outside the sparsity pattern. With index_base = 1 the CSC arrays + ! are already Fortran indices, so the traversal below needs no shifting. + allocate(in_pattern(m, n)) + in_pattern = .false. + max_err = 0.0_c_double + + do j = 1, N_COLS + do k = colptr(j), colptr(j+1) - 1 + i = rowval(k) + in_pattern(i, j) = .true. + err = abs(A(i,j) - nzval(k)) + if (err > max_err) max_err = err + end do + end do + write(*,'(A,I0,A,ES9.3)') "max error on the ", NNZ, " stored entries: ", max_err + + max_leak = 0.0_c_double + do j = 1, N_COLS + do i = 1, M_ROWS + if (.not. in_pattern(i,j)) then + leak = abs(A(i,j)) + if (leak > max_leak) max_leak = leak + end if + end do + end do + write(*,'(A,ES9.3)') "max leakage outside the pattern: ", max_leak + + ! Understating any length is refused with -3, and nothing is read or written + ! before the refusal — the guarantee that lets a handle be reused safely. + short_nzval = smc_compress(result, c_loc(nzval), nzval_len - 1, & + c_null_ptr, 0_c_size_t, c_loc(Bc), Bc_len) + short_Bc = smc_compress(result, c_loc(nzval), nzval_len, & + c_null_ptr, 0_c_size_t, c_loc(Bc), Bc_len - 1) + short_A = smc_decompress(result, c_null_ptr, 0_c_size_t, & + c_loc(Bc), Bc_len, c_loc(A), A_len - 1) + write(*,'(A,I0,A,I0,A,I0)') "short nzval -> ", short_nzval, & + ", short Bc -> ", short_Bc, & + ", short A_out -> ", short_A + + ret = smc_result_free(result) + if (ret /= 0) then + write(error_unit,'(A,I0,A)') "smc_result_free failed (", ret, ")" + stop 1 + end if + + deallocate(in_pattern, Bc, A) + + ! Direct decompression is an exact scatter, so both errors must be zero. Both + ! are absolute values, so > 0 is the exact-equality test, spelled that way to + ! avoid a compiler warning about comparing reals. + if (max_err > 0.0_c_double .or. max_leak > 0.0_c_double) then + write(error_unit,'(A)') "round trip did not reproduce A" + stop 1 + end if + + if (short_nzval /= -3 .or. short_Bc /= -3 .or. short_A /= -3) then + write(error_unit,'(A)') "a short buffer was not rejected" + stop 1 + end if + +end program compress_decompress diff --git a/interfaces/include/smc.f90 b/interfaces/include/smc.f90 new file mode 100644 index 00000000..fe18445e --- /dev/null +++ b/interfaces/include/smc.f90 @@ -0,0 +1,502 @@ +! smc.f90 - Fortran interface to SparseMatrixColorings.jl +! +! Generated by interfaces/scripts/generate_header.jl from the same table as +! smc.h -- do not edit by hand, edit the generator instead. +! +! An include file rather than a module, so that no .mod file has to be shipped +! and any Fortran compiler can consume it: +! +! program my_prog +! use iso_c_binding +! implicit none +! include 'smc.f90' ! <- here, after implicit none +! ... +! end program +! +! Every C pointer is a type(c_ptr), value dummy argument. Pass c_loc(x) +! for an array or a struct you own -- it must carry the target attribute -- +! or c_null_ptr where the C interface accepts NULL. The single exception is +! the void** out-parameter of smc_coloring, declared type(c_ptr), +! intent(out), which receives the opaque result handle. +! +! Dense matrices are column-major, which is already Fortran's own layout, so +! a 2D array can be handed over directly with c_loc. Buffer lengths are +! element counts, never byte counts. + + ! Version + integer(c_int), parameter :: SMC_VERSION_MAJOR = 0 + integer(c_int), parameter :: SMC_VERSION_MINOR = 4 + integer(c_int), parameter :: SMC_VERSION_PATCH = 27 + + ! ------------------------------------------------------------------------- + ! Enumerators (must match smc.h) + ! ------------------------------------------------------------------------- + + ! SmcDataType + ! Element type of the numerical buffers passed to smc_compress and + ! smc_decompress (double or float). The sparsity pattern is always int. + integer(c_int), parameter :: SMC_FLOAT64 = 0 + integer(c_int), parameter :: SMC_FLOAT32 = 1 + + ! SmcStructure + ! Structure of the matrix. SMC_SYMMETRIC states that the sparsity pattern + ! is symmetric and selects the symmetric coloring problems. + integer(c_int), parameter :: SMC_NONSYMMETRIC = 0 + integer(c_int), parameter :: SMC_SYMMETRIC = 1 + + ! SmcPartition + ! Which dimension is colored. SMC_BIDIRECTIONAL colors rows and columns at + ! the same time and produces two compressed matrices. + integer(c_int), parameter :: SMC_COLUMN = 0 + integer(c_int), parameter :: SMC_ROW = 1 + integer(c_int), parameter :: SMC_BIDIRECTIONAL = 2 + + ! SmcDecompression + ! How the nonzeros are recovered from the compressed matrix. + ! SMC_SUBSTITUTION needs fewer colors but is only available for the + ! symmetric-column and bidirectional problems. + integer(c_int), parameter :: SMC_DIRECT = 0 + integer(c_int), parameter :: SMC_SUBSTITUTION = 1 + + ! SmcOrder + ! Vertex order used by the greedy coloring algorithm. + ! RandomOrder is deliberately not exposed by this interface. + integer(c_int), parameter :: SMC_NATURAL = 0 + integer(c_int), parameter :: SMC_LARGEST_FIRST = 1 + integer(c_int), parameter :: SMC_SMALLEST_LAST = 2 + integer(c_int), parameter :: SMC_INCIDENCE_DEGREE = 3 + integer(c_int), parameter :: SMC_DYNAMIC_LARGEST_FIRST = 4 + + ! ------------------------------------------------------------------------- + ! Coloring options (must match the struct in smc.h) + ! + ! Passed to smc_coloring and smc_fast_coloring as c_loc(opts), and + ! remembered by the result handle. Initialise with smc_default_options() + ! before overriding individual fields; c_null_ptr means the defaults. + ! + ! Supported (structure, partition, decompression) combinations; anything + ! else is rejected with -2: + ! SMC_NONSYMMETRIC SMC_COLUMN SMC_DIRECT + ! SMC_NONSYMMETRIC SMC_ROW SMC_DIRECT + ! SMC_SYMMETRIC SMC_COLUMN SMC_DIRECT + ! SMC_SYMMETRIC SMC_COLUMN SMC_SUBSTITUTION + ! SMC_NONSYMMETRIC SMC_BIDIRECTIONAL SMC_DIRECT + ! SMC_NONSYMMETRIC SMC_BIDIRECTIONAL SMC_SUBSTITUTION + ! ------------------------------------------------------------------------- + + type, bind(c) :: SmcColoringOptions + integer(c_int) :: structure ! SmcStructure - default SMC_NONSYMMETRIC + integer(c_int) :: partition ! SmcPartition - default SMC_COLUMN + integer(c_int) :: decompression ! SmcDecompression - default SMC_DIRECT + integer(c_int) :: order ! SmcOrder - default SMC_NATURAL + integer(c_int) :: postprocessing ! 0/1 - give the neutral color 0 to the entries that need no + ! evaluation, where possible (default 0) + integer(c_int) :: symmetric_pattern ! 0/1 - assert that the sparsity pattern is symmetric, + ! skipping the symmetrization step (default 0) + integer(c_int) :: index_base ! 0 or 1 - index base of colptr, rowval and of the group + ! members returned by the queries (default 0) + integer(c_int) :: dtype ! SmcDataType - element type used by smc_compress and + ! smc_decompress (default SMC_FLOAT64) + end type SmcColoringOptions + + ! ------------------------------------------------------------------------- + ! Return codes + ! + ! Every function returning integer(c_int) returns one of: + ! + ! 0 success + ! -1 internal error (a Julia exception was caught and logged) + ! -2 unsupported combination of (structure, partition, decompression, + ! dtype) + ! -3 invalid argument (NULL pointer, bad dimension, buffer too small, + ! bad enum value, bad index_base) + ! -4 invalid or already-freed handle + ! ------------------------------------------------------------------------- + + ! ------------------------------------------------------------------------- + ! C function interfaces + ! ------------------------------------------------------------------------- + + interface + + ! ------------------------------------------------------------------------- + ! smc_default_options + ! + ! Return an SmcColoringOptions filled with the defaults: nonsymmetric + ! structure, column partition, direct decompression, natural order, no + ! postprocessing, no symmetric-pattern assertion, 0-based indices and + ! SMC_FLOAT64. Always start from this call, override the fields you + ! need, then pass c_loc(opts). + ! ------------------------------------------------------------------------- + function smc_default_options() & + bind(c, name='smc_default_options') result(opts) + import :: SmcColoringOptions + type(SmcColoringOptions) :: opts + end function smc_default_options + + ! ------------------------------------------------------------------------- + ! smc_version + ! + ! Write the SparseMatrixColorings.jl version of this library into major, + ! minor and patch (the same values as the SMC_VERSION_* parameters). + ! Pass c_loc of three integer(c_int), target scalars. + ! ------------------------------------------------------------------------- + subroutine smc_version(major, minor, patch) & + bind(c, name='smc_version') + use iso_c_binding + integer(c_int), intent(out) :: major, minor, patch + end subroutine smc_version + + ! ------------------------------------------------------------------------- + ! Coloring + ! + ! The pattern is always given in CSC form, in opts%index_base. The + ! caller's arrays are copied and never modified. + ! ------------------------------------------------------------------------- + + ! ------------------------------------------------------------------------- + ! smc_coloring + ! + ! Color the m-by-n sparsity pattern given in CSC form and return an + ! opaque result handle through result_out. + ! m, n : number of rows and columns, both > 0 + ! colptr : c_loc of n+1 column pointers, in opts%index_base + ! rowval : c_loc of the row indices of the nonzeros, in + ! opts%index_base, length colptr(n+1) - colptr(1) + ! opts : c_loc(options), or c_null_ptr for the defaults + ! result_out : receives the handle; release it with smc_result_free + ! Returns 0, -1 internal error, -2 unsupported combination, -3 invalid + ! argument. + ! ------------------------------------------------------------------------- + function smc_coloring(m, n, colptr, rowval, opts, result_out) & + bind(c, name='smc_coloring') result(ret) + use iso_c_binding + integer(c_int), value :: m, n + type(c_ptr), value :: colptr, rowval, opts + type(c_ptr), intent(out) :: result_out + integer(c_int) :: ret + end function smc_coloring + + ! ------------------------------------------------------------------------- + ! smc_fast_coloring + ! + ! Color the pattern and write the colors directly, without allocating a + ! handle. The groups and the compression helpers need smc_coloring. + ! row_colors : c_loc of a length-m buffer, c_null_ptr when the + ! partition produces no row coloring (SMC_COLUMN) + ! column_colors : c_loc of a length-n buffer, c_null_ptr when the + ! partition produces no column coloring (SMC_ROW) + ! ncolors_out : c_loc of a scalar receiving the number of colors + ! SMC_BIDIRECTIONAL fills both buffers, so neither may be c_null_ptr. + ! Colors are labels in 1..ncolors; 0 marks an entry that needs no + ! evaluation and can only appear when opts%postprocessing is 1. + ! Returns 0, -1 internal error, -2 unsupported combination, -3 invalid + ! argument. + ! ------------------------------------------------------------------------- + function smc_fast_coloring(m, n, colptr, rowval, opts, row_colors, column_colors, & + ncolors_out) & + bind(c, name='smc_fast_coloring') result(ret) + use iso_c_binding + integer(c_int), value :: m, n + type(c_ptr), value :: colptr, rowval, opts, row_colors, column_colors, ncolors_out + integer(c_int) :: ret + end function smc_fast_coloring + + ! ------------------------------------------------------------------------- + ! smc_result_free + ! + ! Release a handle returned by smc_coloring; it must not be used again. + ! Returns 0, or -4 if the handle is unknown (freeing twice is safe). + ! ------------------------------------------------------------------------- + function smc_result_free(result) & + bind(c, name='smc_result_free') result(ret) + use iso_c_binding + type(c_ptr), value :: result + integer(c_int) :: ret + end function smc_result_free + + ! ------------------------------------------------------------------------- + ! Queries + ! + ! All of them take a handle from smc_coloring. Every buffer crossing + ! the interface carries its own length, that length is checked before a + ! single element is read or written, and every sizing question has a + ! query, so a caller can always ask before allocating: + ! + ! buffer length argument how to obtain the required length + ! colors len n (columns) or m (rows), from smc_size + ! members len smc_column_group_size / smc_row_group_size + ! nzval nzval_len smc_nnz + ! Bc Bc_len Bc_rows*Bc_cols, smc_compressed_size + ! Br Br_len Br_rows*Br_cols, smc_compressed_size + ! A_out A_len m*n, from smc_size + ! + ! Lengths are element counts, never byte counts. The numerical + ! buffers use size_t rather than int because A_len is m*n, which + ! overflows a 32-bit int. Too small a buffer is rejected with -3. + ! ------------------------------------------------------------------------- + + ! ------------------------------------------------------------------------- + ! smc_ncolors + ! + ! Write the total number of colors into the scalar pointed to by + ! ncolors_out. Returns 0, -3 invalid argument, -4 invalid handle. + ! ------------------------------------------------------------------------- + function smc_ncolors(result, ncolors_out) & + bind(c, name='smc_ncolors') result(ret) + use iso_c_binding + type(c_ptr), value :: result, ncolors_out + integer(c_int) :: ret + end function smc_ncolors + + ! ------------------------------------------------------------------------- + ! smc_column_colors + ! + ! Copy the color of every column into colors; len must be at least n. + ! Colors are labels in 1..ncolors, 0 meaning "no evaluation needed". + ! Returns 0, -2 if the partition has no column coloring, -3 invalid + ! argument (including len < n), -4 invalid handle. + ! ------------------------------------------------------------------------- + function smc_column_colors(result, colors, len) & + bind(c, name='smc_column_colors') result(ret) + use iso_c_binding + type(c_ptr), value :: result, colors + integer(c_int), value :: len + integer(c_int) :: ret + end function smc_column_colors + + ! ------------------------------------------------------------------------- + ! smc_row_colors + ! + ! Copy the color of every row into colors; len must be at least m. + ! Colors are labels in 1..ncolors, 0 meaning "no evaluation needed". + ! Returns 0, -2 if the partition has no row coloring, -3 invalid + ! argument (including len < m), -4 invalid handle. + ! ------------------------------------------------------------------------- + function smc_row_colors(result, colors, len) & + bind(c, name='smc_row_colors') result(ret) + use iso_c_binding + type(c_ptr), value :: result, colors + integer(c_int), value :: len + integer(c_int) :: ret + end function smc_row_colors + + ! ------------------------------------------------------------------------- + ! smc_ncolumn_groups + ! + ! Write the number of column groups into ngroups_out. Groups are the + ! color classes: group g holds every column colored g. + ! Returns 0, -2 if the partition has no column coloring, -3 invalid + ! argument, -4 invalid handle. + ! ------------------------------------------------------------------------- + function smc_ncolumn_groups(result, ngroups_out) & + bind(c, name='smc_ncolumn_groups') result(ret) + use iso_c_binding + type(c_ptr), value :: result, ngroups_out + integer(c_int) :: ret + end function smc_ncolumn_groups + + ! ------------------------------------------------------------------------- + ! smc_nrow_groups + ! + ! Write the number of row groups into ngroups_out. + ! Returns 0, -2 if the partition has no row coloring, -3 invalid + ! argument, -4 invalid handle. + ! ------------------------------------------------------------------------- + function smc_nrow_groups(result, ngroups_out) & + bind(c, name='smc_nrow_groups') result(ret) + use iso_c_binding + type(c_ptr), value :: result, ngroups_out + integer(c_int) :: ret + end function smc_nrow_groups + + ! ------------------------------------------------------------------------- + ! smc_column_group_size + ! + ! Write the number of columns in column group `group` into size_out. + ! `group` is 1-based and runs over 1..smc_ncolumn_groups, independently + ! of opts%index_base. Query the size first, then fetch the members. + ! Returns 0, -2 if the partition has no column coloring, -3 invalid + ! argument (including an out-of-range group), -4 invalid handle. + ! ------------------------------------------------------------------------- + function smc_column_group_size(result, group, size_out) & + bind(c, name='smc_column_group_size') result(ret) + use iso_c_binding + type(c_ptr), value :: result + integer(c_int), value :: group + type(c_ptr), value :: size_out + integer(c_int) :: ret + end function smc_column_group_size + + ! ------------------------------------------------------------------------- + ! smc_column_group + ! + ! Copy the column indices of column group `group` into members; len must + ! be at least smc_column_group_size(result, group, ...). The indices are + ! written in opts%index_base. + ! Returns 0, -2 if the partition has no column coloring, -3 invalid + ! argument (including len too small), -4 invalid handle. + ! ------------------------------------------------------------------------- + function smc_column_group(result, group, members, len) & + bind(c, name='smc_column_group') result(ret) + use iso_c_binding + type(c_ptr), value :: result + integer(c_int), value :: group + type(c_ptr), value :: members + integer(c_int), value :: len + integer(c_int) :: ret + end function smc_column_group + + ! ------------------------------------------------------------------------- + ! smc_row_group_size + ! + ! Write the number of rows in row group `group` into size_out. `group` + ! is 1-based and runs over 1..smc_nrow_groups. + ! Returns 0, -2 if the partition has no row coloring, -3 invalid + ! argument (including an out-of-range group), -4 invalid handle. + ! ------------------------------------------------------------------------- + function smc_row_group_size(result, group, size_out) & + bind(c, name='smc_row_group_size') result(ret) + use iso_c_binding + type(c_ptr), value :: result + integer(c_int), value :: group + type(c_ptr), value :: size_out + integer(c_int) :: ret + end function smc_row_group_size + + ! ------------------------------------------------------------------------- + ! smc_row_group + ! + ! Copy the row indices of row group `group` into members; len must be at + ! least smc_row_group_size(result, group, ...). The indices are written + ! in opts%index_base. + ! Returns 0, -2 if the partition has no row coloring, -3 invalid + ! argument (including len too small), -4 invalid handle. + ! ------------------------------------------------------------------------- + function smc_row_group(result, group, members, len) & + bind(c, name='smc_row_group') result(ret) + use iso_c_binding + type(c_ptr), value :: result + integer(c_int), value :: group + type(c_ptr), value :: members + integer(c_int), value :: len + integer(c_int) :: ret + end function smc_row_group + + ! ------------------------------------------------------------------------- + ! smc_nnz + ! + ! Write the number of stored entries of the sparsity pattern this result + ! was built from into nnz_out. That is exactly the required nzval_len + ! of smc_compress. + ! Returns 0, -3 invalid argument, -4 invalid handle. + ! ------------------------------------------------------------------------- + function smc_nnz(result, nnz_out) & + bind(c, name='smc_nnz') result(ret) + use iso_c_binding + type(c_ptr), value :: result, nnz_out + integer(c_int) :: ret + end function smc_nnz + + ! ------------------------------------------------------------------------- + ! smc_size + ! + ! Write the dimensions of the matrix this result was built from into + ! m_out and n_out: the lengths expected by smc_row_colors (m) and + ! smc_column_colors (n), and A_len must be at least m*n. + ! Both pointers must be non-NULL. + ! Returns 0, -3 invalid argument, -4 invalid handle. + ! ------------------------------------------------------------------------- + function smc_size(result, m_out, n_out) & + bind(c, name='smc_size') result(ret) + use iso_c_binding + type(c_ptr), value :: result, m_out, n_out + integer(c_int) :: ret + end function smc_size + + ! ------------------------------------------------------------------------- + ! Compression / decompression + ! + ! Dense matrices are column-major (Fortran / Julia order) and hold + ! double or float elements according to opts%dtype. + ! ------------------------------------------------------------------------- + + ! ------------------------------------------------------------------------- + ! smc_compressed_size + ! + ! Report the dimensions of the compressed matrices, so the caller can + ! size the buffers of smc_compress and smc_decompress. + ! Bc : m-by-ncolors for a column partition, ncolors-by-n for a row + ! partition, m-by-ncolumn_groups for a bidirectional one + ! Br : nrow_groups-by-n, used only by SMC_BIDIRECTIONAL; for the other + ! partitions Br_rows and Br_cols are set to 0 + ! All four pointers must be non-NULL. + ! Returns 0, -3 invalid argument, -4 invalid handle. + ! ------------------------------------------------------------------------- + function smc_compressed_size(result, Br_rows, Br_cols, Bc_rows, Bc_cols) & + bind(c, name='smc_compressed_size') result(ret) + use iso_c_binding + type(c_ptr), value :: result, Br_rows, Br_cols, Bc_rows, Bc_cols + integer(c_int) :: ret + end function smc_compressed_size + + ! ------------------------------------------------------------------------- + ! smc_compress + ! + ! Compress the matrix into the dense buffers Br and Bc. Every buffer is + ! followed by its length, counted in elements of the type selected by + ! opts%dtype -- never in bytes. + ! nzval, nzval_len : c_loc of the CSC values, in the same order as the + ! rowval given to smc_coloring, real(c_double) or + ! real(c_float) according to opts%dtype; nzval_len + ! at least smc_nnz + ! Br, Br_len : row-compressed matrix, used only by + ! SMC_BIDIRECTIONAL; otherwise c_null_ptr and 0 + ! Bc, Bc_len : column-compressed matrix, at least Bc_rows*Bc_cols + ! Both buffers are column-major with the dimensions reported by + ! smc_compressed_size, which is Fortran's own layout: B(i,j). + ! Returns 0, -1 internal error, -3 invalid argument (a c_null_ptr the + ! partition needs, or a buffer too small), -4 invalid handle. + ! ------------------------------------------------------------------------- + function smc_compress(result, nzval, nzval_len, Br, Br_len, Bc, Bc_len) & + bind(c, name='smc_compress') result(ret) + use iso_c_binding + type(c_ptr), value :: result, nzval + integer(c_size_t), value :: nzval_len + type(c_ptr), value :: Br + integer(c_size_t), value :: Br_len + type(c_ptr), value :: Bc + integer(c_size_t), value :: Bc_len + integer(c_int) :: ret + end function smc_compress + + ! ------------------------------------------------------------------------- + ! smc_decompress + ! + ! Recover the full m-by-n dense matrix from the compressed form. Every + ! buffer is followed by its length, counted in elements of the type + ! selected by opts%dtype -- never in bytes. + ! Br, Br_len : the buffer filled by smc_compress, used only by + ! SMC_BIDIRECTIONAL; otherwise c_null_ptr and 0 + ! Bc, Bc_len : the buffer filled by smc_compress, at least + ! Bc_rows*Bc_cols from smc_compressed_size + ! A_out, A_len : m*n elements, column-major, of the type selected by + ! opts%dtype; A_len at least m*n, with m and n from + ! smc_size + ! Entries outside the sparsity pattern are set to zero. + ! Returns 0, -1 internal error, -3 invalid argument (a c_null_ptr the + ! partition needs, or a buffer too small), -4 invalid handle. + ! ------------------------------------------------------------------------- + function smc_decompress(result, Br, Br_len, Bc, Bc_len, A_out, A_len) & + bind(c, name='smc_decompress') result(ret) + use iso_c_binding + type(c_ptr), value :: result, Br + integer(c_size_t), value :: Br_len + type(c_ptr), value :: Bc + integer(c_size_t), value :: Bc_len + type(c_ptr), value :: A_out + integer(c_size_t), value :: A_len + integer(c_int) :: ret + end function smc_decompress + + end interface diff --git a/interfaces/include/smc.h b/interfaces/include/smc.h new file mode 100644 index 00000000..44bbfcaf --- /dev/null +++ b/interfaces/include/smc.h @@ -0,0 +1,404 @@ +#ifndef SMC_H +#define SMC_H + +#include /* size_t */ + +/* Version */ +#define SMC_VERSION_MAJOR 0 +#define SMC_VERSION_MINOR 4 +#define SMC_VERSION_PATCH 27 + +#ifdef __cplusplus +extern "C" { +#endif + +/* ------------------------------------------------------------------------- + * libsmc - C interface to SparseMatrixColorings.jl + * + * Typical use: + * + * SmcColoringOptions opts = smc_default_options(); + * opts.structure = SMC_NONSYMMETRIC; + * opts.partition = SMC_COLUMN; + * opts.order = SMC_LARGEST_FIRST; + * + * void *result; + * if (smc_coloring(m, n, colptr, rowval, &opts, &result) != 0) { ... } + * + * int nc; + * smc_ncolors(result, &nc); + * int *colors = malloc(n * sizeof(int)); + * smc_column_colors(result, colors, n); + * + * int Br_rows, Br_cols, Bc_rows, Bc_cols; + * smc_compressed_size(result, &Br_rows, &Br_cols, &Bc_rows, &Bc_cols); + * size_t Bc_len = (size_t) Bc_rows * (size_t) Bc_cols; + * double *Bc = malloc(Bc_len * sizeof(double)); + * + * int nnz; + * smc_nnz(result, &nnz); + * smc_compress(result, nzval, (size_t) nnz, NULL, 0, Bc, Bc_len); + * + * smc_result_free(result); + * + * The sparsity pattern is passed in compressed sparse column form: colptr + * has n+1 entries, rowval has colptr[n] - colptr[0] entries, and both use + * the index base selected by opts.index_base (0 by default). The caller's + * arrays are copied, never modified. Coloring is structure-only: the + * numerical values are needed only by smc_compress. + * + * Indices crossing the interface are 32-bit int; matrices with more than + * 2^31 nonzeros are out of scope. Dense matrices are column-major, with + * double or float elements according to opts.dtype. + * + * Every output buffer is caller-allocated and every buffer argument is + * immediately followed by its length, counted in elements, never in bytes. + * ------------------------------------------------------------------------- */ + +/* ------------------------------------------------------------------------- + * Enumerators + * ------------------------------------------------------------------------- */ + +/* + * Element type of the numerical buffers passed to smc_compress and + * smc_decompress (double or float). The sparsity pattern is always int. + */ +typedef enum { + SMC_FLOAT64 = 0, + SMC_FLOAT32 = 1 +} SmcDataType; + +/* + * Structure of the matrix. SMC_SYMMETRIC states that the sparsity pattern + * is symmetric and selects the symmetric coloring problems. + */ +typedef enum { + SMC_NONSYMMETRIC = 0, + SMC_SYMMETRIC = 1 +} SmcStructure; + +/* + * Which dimension is colored. SMC_BIDIRECTIONAL colors rows and columns at + * the same time and produces two compressed matrices. + */ +typedef enum { + SMC_COLUMN = 0, + SMC_ROW = 1, + SMC_BIDIRECTIONAL = 2 +} SmcPartition; + +/* + * How the nonzeros are recovered from the compressed matrix. + * SMC_SUBSTITUTION needs fewer colors but is only available for the + * symmetric-column and bidirectional problems. + */ +typedef enum { + SMC_DIRECT = 0, + SMC_SUBSTITUTION = 1 +} SmcDecompression; + +/* + * Vertex order used by the greedy coloring algorithm. + * RandomOrder is deliberately not exposed by this interface. + */ +typedef enum { + SMC_NATURAL = 0, + SMC_LARGEST_FIRST = 1, + SMC_SMALLEST_LAST = 2, + SMC_INCIDENCE_DEGREE = 3, + SMC_DYNAMIC_LARGEST_FIRST = 4 +} SmcOrder; + +/* ------------------------------------------------------------------------- + * Coloring options + * + * Passed to smc_coloring and smc_fast_coloring, and remembered by the + * result handle. Initialise with smc_default_options() before overriding + * individual fields; a NULL options pointer means the defaults. + * + * Supported (structure, partition, decompression) combinations; anything + * else is rejected with -2: + * SMC_NONSYMMETRIC SMC_COLUMN SMC_DIRECT + * SMC_NONSYMMETRIC SMC_ROW SMC_DIRECT + * SMC_SYMMETRIC SMC_COLUMN SMC_DIRECT + * SMC_SYMMETRIC SMC_COLUMN SMC_SUBSTITUTION + * SMC_NONSYMMETRIC SMC_BIDIRECTIONAL SMC_DIRECT + * SMC_NONSYMMETRIC SMC_BIDIRECTIONAL SMC_SUBSTITUTION + * ------------------------------------------------------------------------- */ + +typedef struct { + int structure; /* SmcStructure - default SMC_NONSYMMETRIC */ + int partition; /* SmcPartition - default SMC_COLUMN */ + int decompression; /* SmcDecompression - default SMC_DIRECT */ + int order; /* SmcOrder - default SMC_NATURAL */ + int postprocessing; /* 0/1 - give the neutral color 0 to the entries that need no */ + /* evaluation, where possible (default 0) */ + int symmetric_pattern; /* 0/1 - assert that the sparsity pattern is symmetric, */ + /* skipping the symmetrization step (default 0) */ + int index_base; /* 0 or 1 - index base of colptr, rowval and of the group */ + /* members returned by the queries (default 0) */ + int dtype; /* SmcDataType - element type used by smc_compress and */ + /* smc_decompress (default SMC_FLOAT64) */ +} SmcColoringOptions; + +/* ------------------------------------------------------------------------- + * Return codes + * + * Every function returning int returns one of: + * + * 0 success + * -1 internal error (a Julia exception was caught and logged) + * -2 unsupported combination of (structure, partition, decompression, + * dtype) + * -3 invalid argument (NULL pointer, bad dimension, buffer too small, + * bad enum value, bad index_base) + * -4 invalid or already-freed handle + * ------------------------------------------------------------------------- */ + +/* ------------------------------------------------------------------------- + * API functions + * ------------------------------------------------------------------------- */ + +/* + * Return an SmcColoringOptions filled with the defaults: nonsymmetric + * structure, column partition, direct decompression, natural order, no + * postprocessing, no symmetric-pattern assertion, 0-based indices and + * SMC_FLOAT64. Always initialise an options struct with this call before + * overriding individual fields. + */ +SmcColoringOptions smc_default_options(void); + +/* + * Write the SparseMatrixColorings.jl version of this library into + * *major, *minor, *patch (the same values as the SMC_VERSION_* macros). + */ +void smc_version(int* major, int* minor, int* patch); + +/* ------------------------------------------------------------------------- + * Coloring + * + * The pattern is always given in CSC form, in opts->index_base. The + * caller's arrays are copied and never modified. + * ------------------------------------------------------------------------- */ + +/* + * Color the m-by-n sparsity pattern given in CSC form and return an opaque + * result handle through *result_out. Only the structure is needed here; + * the numerical values are passed later to smc_compress. + * m, n : number of rows and columns, both > 0 + * colptr : n+1 column pointers, in opts->index_base + * rowval : row indices of the nonzeros, in opts->index_base, + * length colptr[n] - colptr[0] + * opts : coloring options, or NULL for smc_default_options() + * result_out : receives the handle; release it with smc_result_free + * Returns 0, -1 on an internal error, -2 if the combination of structure, + * partition, decompression and dtype is unsupported, -3 on an invalid + * argument. + */ +int smc_coloring(int m, int n, const int* colptr, const int* rowval, const SmcColoringOptions* opts, void** result_out); + +/* + * Color the pattern and write the colors directly, without allocating a + * handle. Convenient when only the colors are needed; the groups and the + * compression helpers require smc_coloring instead. + * row_colors : length-m buffer, may be NULL when the partition + * produces no row coloring (SMC_COLUMN) + * column_colors : length-n buffer, may be NULL when the partition + * produces no column coloring (SMC_ROW) + * ncolors_out : receives the number of colors + * SMC_BIDIRECTIONAL fills both buffers, so neither may be NULL. + * Colors are labels in 1..ncolors; 0 marks an entry that needs no + * evaluation and can only appear when opts->postprocessing is 1. Color + * labels are never shifted by opts->index_base. + * Returns 0, -1 on an internal error, -2 on an unsupported combination, + * -3 on an invalid argument. + */ +int smc_fast_coloring(int m, int n, const int* colptr, const int* rowval, const SmcColoringOptions* opts, int* row_colors, int* column_colors, int* ncolors_out); + +/* + * Release a handle returned by smc_coloring; it must not be used again. + * Returns 0, or -4 if the handle is unknown (freeing twice is safe). + */ +int smc_result_free(void* result); + +/* ------------------------------------------------------------------------- + * Queries + * + * All of them take a handle from smc_coloring. Every buffer crossing + * the interface carries its own length, that length is checked before a + * single element is read or written, and every sizing question has a + * query, so a caller can always ask before allocating: + * + * buffer length argument how to obtain the required length + * colors len n (columns) or m (rows), from smc_size + * members len smc_column_group_size / smc_row_group_size + * nzval nzval_len smc_nnz + * Bc Bc_len Bc_rows*Bc_cols, smc_compressed_size + * Br Br_len Br_rows*Br_cols, smc_compressed_size + * A_out A_len m*n, from smc_size + * + * Lengths are element counts, never byte counts. The numerical + * buffers use size_t rather than int because A_len is m*n, which + * overflows a 32-bit int. Too small a buffer is rejected with -3. + * ------------------------------------------------------------------------- */ + +/* + * Write the total number of colors of the result into *ncolors_out. + * Returns 0, -3 on an invalid argument, -4 on an invalid handle. + */ +int smc_ncolors(void* result, int* ncolors_out); + +/* + * Copy the color of every column into `colors`; `len` must be at least n. + * Colors are labels in 1..ncolors, 0 meaning "no evaluation needed". + * Returns 0, -2 if the partition has no column coloring, -3 on an invalid + * argument (including len < n), -4 on an invalid handle. + */ +int smc_column_colors(void* result, int* colors, int len); + +/* + * Copy the color of every row into `colors`; `len` must be at least m. + * Colors are labels in 1..ncolors, 0 meaning "no evaluation needed". + * Returns 0, -2 if the partition has no row coloring, -3 on an invalid + * argument (including len < m), -4 on an invalid handle. + */ +int smc_row_colors(void* result, int* colors, int len); + +/* + * Write the number of column groups into *ngroups_out. Groups are the + * color classes: group g holds every column colored g. + * Returns 0, -2 if the partition has no column coloring, -3 on an invalid + * argument, -4 on an invalid handle. + */ +int smc_ncolumn_groups(void* result, int* ngroups_out); + +/* + * Write the number of row groups into *ngroups_out. + * Returns 0, -2 if the partition has no row coloring, -3 on an invalid + * argument, -4 on an invalid handle. + */ +int smc_nrow_groups(void* result, int* ngroups_out); + +/* + * Write the number of columns in column group `group` into *size_out. + * `group` is 1-based and runs over 1..smc_ncolumn_groups, independently of + * opts->index_base. Query the size first, then fetch the members. + * Returns 0, -2 if the partition has no column coloring, -3 on an invalid + * argument (including an out-of-range group), -4 on an invalid handle. + */ +int smc_column_group_size(void* result, int group, int* size_out); + +/* + * Copy the column indices of column group `group` into `members`; `len` + * must be at least smc_column_group_size(result, group). The indices are + * written in opts->index_base. + * Returns 0, -2 if the partition has no column coloring, -3 on an invalid + * argument (including len too small), -4 on an invalid handle. + */ +int smc_column_group(void* result, int group, int* members, int len); + +/* + * Write the number of rows in row group `group` into *size_out. `group` + * is 1-based and runs over 1..smc_nrow_groups. + * Returns 0, -2 if the partition has no row coloring, -3 on an invalid + * argument (including an out-of-range group), -4 on an invalid handle. + */ +int smc_row_group_size(void* result, int group, int* size_out); + +/* + * Copy the row indices of row group `group` into `members`; `len` must be + * at least smc_row_group_size(result, group). The indices are written in + * opts->index_base. + * Returns 0, -2 if the partition has no row coloring, -3 on an invalid + * argument (including len too small), -4 on an invalid handle. + */ +int smc_row_group(void* result, int group, int* members, int len); + +/* + * Write the number of stored entries of the sparsity pattern this result + * was built from into *nnz_out. That is exactly the number of elements + * `nzval` must have in smc_compress, i.e. the required nzval_len. + * Returns 0, -3 on an invalid argument, -4 on an invalid handle. + */ +int smc_nnz(void* result, int* nnz_out); + +/* + * Write the dimensions of the matrix this result was built from into + * *m_out and *n_out. They are the lengths expected by smc_row_colors (m) + * and smc_column_colors (n), and A_out in smc_decompress must hold m*n + * elements, i.e. A_len must be at least m*n. + * Both out pointers must be non-NULL. + * Returns 0, -3 on an invalid argument, -4 on an invalid handle. + */ +int smc_size(void* result, int* m_out, int* n_out); + +/* ------------------------------------------------------------------------- + * Compression / decompression + * + * Dense matrices are column-major (Fortran / Julia order) and hold + * double or float elements according to opts->dtype. + * ------------------------------------------------------------------------- */ + +/* + * Report the dimensions of the compressed matrices, so the caller can size + * the buffers of smc_compress and smc_decompress. + * Bc : m-by-ncolors for a column partition, ncolors-by-n for a row + * partition, m-by-ncolumn_groups for a bidirectional one + * Br : nrow_groups-by-n, and used only by SMC_BIDIRECTIONAL; for the + * other partitions *Br_rows and *Br_cols are set to 0 + * The Bc_len and Br_len arguments of smc_compress and smc_decompress must + * be at least Bc_rows*Bc_cols and Br_rows*Br_cols respectively. + * All four out pointers must be non-NULL. + * Returns 0, -3 on an invalid argument, -4 on an invalid handle. + */ +int smc_compressed_size(void* result, int* Br_rows, int* Br_cols, int* Bc_rows, int* Bc_cols); + +/* + * Compress the matrix into the dense buffers Br and Bc. Every buffer is + * followed by its length, counted in elements of the type selected by + * opts->dtype -- never in bytes. + * nzval, nzval_len : the CSC values, in the same order as the rowval + * given to smc_coloring; double* or float* according + * to opts->dtype. nzval_len must be at least the + * value reported by smc_nnz + * Br, Br_len : row-compressed matrix, used only by + * SMC_BIDIRECTIONAL; for the other partitions Br + * may be NULL and Br_len 0. A bidirectional result + * requires it, with Br_len at least Br_rows*Br_cols + * from smc_compressed_size + * Bc, Bc_len : column-compressed matrix; Bc_len must be at least + * Bc_rows*Bc_cols from smc_compressed_size + * Both buffers are column-major with the dimensions reported by + * smc_compressed_size: B[i,j] is B[j*rows + i]. + * Returns 0, -1 on an internal error, -3 on an invalid argument (a NULL + * buffer the partition needs, or a buffer too small), -4 on an invalid + * handle. + */ +int smc_compress(void* result, const void* nzval, size_t nzval_len, void* Br, size_t Br_len, void* Bc, size_t Bc_len); + +/* + * Recover the full m-by-n dense matrix from the compressed form. Every + * buffer is followed by its length, counted in elements of the type + * selected by opts->dtype -- never in bytes. + * Br, Br_len : the buffer filled by smc_compress, used only by + * SMC_BIDIRECTIONAL; for the other partitions Br may be + * NULL and Br_len 0. A bidirectional result requires + * it, with Br_len at least Br_rows*Br_cols from + * smc_compressed_size + * Bc, Bc_len : the buffer filled by smc_compress; Bc_len must be at + * least Bc_rows*Bc_cols from smc_compressed_size + * A_out, A_len : m*n elements, column-major, of the type selected by + * opts->dtype; A_out[i,j] is A_out[j*m + i]. A_len must + * be at least m*n, with m and n from smc_size + * Entries outside the sparsity pattern are set to zero. + * Returns 0, -1 on an internal error, -3 on an invalid argument (a NULL + * buffer the partition needs, or a buffer too small), -4 on an invalid + * handle. + */ +int smc_decompress(void* result, const void* Br, size_t Br_len, const void* Bc, size_t Bc_len, void* A_out, size_t A_len); + +#ifdef __cplusplus +} +#endif + +#endif /* SMC_H */ diff --git a/interfaces/scripts/coloring_table.jl b/interfaces/scripts/coloring_table.jl new file mode 100644 index 00000000..9910134c --- /dev/null +++ b/interfaces/scripts/coloring_table.jl @@ -0,0 +1,217 @@ +# coloring_table.jl — single source of truth for the libsmc combination tables. +# +# Pure data: no `using`, no dependency on SparseMatrixColorings, so it can be +# loaded both by `interfaces/src/c_stores.jl` (through `LibSMC.jl`) and by +# `interfaces/scripts/generate_header.jl`, into a bare `Module`. +# +# The values are part of the ABI: +# entry `i` of each enum table has the value `i - 1`; those numbers never move. + +# Enumerators. Each entry is (C enumerator, Julia +# counterpart as it appears in LibSMC.jl); its value is its 0-based position. + +const DTYPES = [("SMC_FLOAT64", "Float64"), ("SMC_FLOAT32", "Float32")] + +const STRUCTURES = [("SMC_NONSYMMETRIC", ":nonsymmetric"), ("SMC_SYMMETRIC", ":symmetric")] + +const PARTITIONS = [ + ("SMC_COLUMN", ":column"), ("SMC_ROW", ":row"), ("SMC_BIDIRECTIONAL", ":bidirectional") +] + +const DECOMPRESSIONS = [("SMC_DIRECT", ":direct"), ("SMC_SUBSTITUTION", ":substitution")] + +# `RandomOrder` is excluded from v1: it carries an `AbstractRNG`, untested under +# `--trim=safe`. Every order below is a singleton, hence a literal constructor. +const ORDERS = [ + ("SMC_NATURAL", "NaturalOrder()"), + ("SMC_LARGEST_FIRST", "LargestFirst()"), + ("SMC_SMALLEST_LAST", "DynamicDegreeBasedOrder{:back,:high2low,false}()"), + ("SMC_INCIDENCE_DEGREE", "DynamicDegreeBasedOrder{:back,:low2high,false}()"), + ("SMC_DYNAMIC_LARGEST_FIRST", "DynamicDegreeBasedOrder{:forward,:low2high,false}()"), +] + +# Enum values as `Cint`: comparable with the fields of `SmcColoringOptions`. + +const SMC_FLOAT64 = Cint(0) +const SMC_FLOAT32 = Cint(1) + +const SMC_NONSYMMETRIC = Cint(0) +const SMC_SYMMETRIC = Cint(1) + +const SMC_COLUMN = Cint(0) +const SMC_ROW = Cint(1) +const SMC_BIDIRECTIONAL = Cint(2) + +const SMC_DIRECT = Cint(0) +const SMC_SUBSTITUTION = Cint(1) + +const SMC_NATURAL = Cint(0) +const SMC_LARGEST_FIRST = Cint(1) +const SMC_SMALLEST_LAST = Cint(2) +const SMC_INCIDENCE_DEGREE = Cint(3) +const SMC_DYNAMIC_LARGEST_FIRST = Cint(4) + +# Largest admissible value of each option, used by the -3 range checks. +const SMC_MAX_DTYPE = SMC_FLOAT32 +const SMC_MAX_STRUCTURE = SMC_SYMMETRIC +const SMC_MAX_PARTITION = SMC_BIDIRECTIONAL +const SMC_MAX_DECOMPRESSION = SMC_SUBSTITUTION +const SMC_MAX_ORDER = SMC_DYNAMIC_LARGEST_FIRST + +# Combo key: +# +# key = structure * 16 + partition * 4 + decompression * 2 + dtype +# +# It fits in a `UInt8` and is what the handle -> key store records, so that +# every later call can recover the concrete type of the result it was given. + +function combo_key(structure, partition, decompression, dtype) + return UInt8(structure * 16 + partition * 4 + decompression * 2 + dtype) +end + +# Key that no combination can produce: "this handle is unknown" (-> return -4). +const KEY_INVALID = 0xff + +const KEY_NS_COL_DIRECT_F64 = combo_key( + SMC_NONSYMMETRIC, SMC_COLUMN, SMC_DIRECT, SMC_FLOAT64 +) +const KEY_NS_COL_DIRECT_F32 = combo_key( + SMC_NONSYMMETRIC, SMC_COLUMN, SMC_DIRECT, SMC_FLOAT32 +) +const KEY_NS_ROW_DIRECT_F64 = combo_key(SMC_NONSYMMETRIC, SMC_ROW, SMC_DIRECT, SMC_FLOAT64) +const KEY_NS_ROW_DIRECT_F32 = combo_key(SMC_NONSYMMETRIC, SMC_ROW, SMC_DIRECT, SMC_FLOAT32) +const KEY_NS_BID_DIRECT_F64 = combo_key( + SMC_NONSYMMETRIC, SMC_BIDIRECTIONAL, SMC_DIRECT, SMC_FLOAT64 +) +const KEY_NS_BID_DIRECT_F32 = combo_key( + SMC_NONSYMMETRIC, SMC_BIDIRECTIONAL, SMC_DIRECT, SMC_FLOAT32 +) +const KEY_NS_BID_SUBST_F64 = combo_key( + SMC_NONSYMMETRIC, SMC_BIDIRECTIONAL, SMC_SUBSTITUTION, SMC_FLOAT64 +) +const KEY_NS_BID_SUBST_F32 = combo_key( + SMC_NONSYMMETRIC, SMC_BIDIRECTIONAL, SMC_SUBSTITUTION, SMC_FLOAT32 +) +const KEY_SYM_COL_DIRECT_F64 = combo_key(SMC_SYMMETRIC, SMC_COLUMN, SMC_DIRECT, SMC_FLOAT64) +const KEY_SYM_COL_DIRECT_F32 = combo_key(SMC_SYMMETRIC, SMC_COLUMN, SMC_DIRECT, SMC_FLOAT32) +const KEY_SYM_COL_SUBST_F64 = combo_key( + SMC_SYMMETRIC, SMC_COLUMN, SMC_SUBSTITUTION, SMC_FLOAT64 +) +const KEY_SYM_COL_SUBST_F32 = combo_key( + SMC_SYMMETRIC, SMC_COLUMN, SMC_SUBSTITUTION, SMC_FLOAT32 +) + +# The same keys with the `dtype` bit cleared: `smc_fast_coloring` never builds a +# result object and therefore never looks at `dtype`. +const BKEY_NS_COL_DIRECT = KEY_NS_COL_DIRECT_F64 +const BKEY_NS_ROW_DIRECT = KEY_NS_ROW_DIRECT_F64 +const BKEY_NS_BID_DIRECT = KEY_NS_BID_DIRECT_F64 +const BKEY_NS_BID_SUBST = KEY_NS_BID_SUBST_F64 +const BKEY_SYM_COL_DIRECT = KEY_SYM_COL_DIRECT_F64 +const BKEY_SYM_COL_SUBST = KEY_SYM_COL_SUBST_F64 + +# The nine typed stores. Each entry is +# (store number, store name, [keys routed to it], structure, partition, +# decompression, dtype or "both", concrete value type) +# for a `SparseMatrixCSC{Float64,Int64}` input. `decompression_eltype` does not +# appear in the Column / Row / StarSet result types, so those three are +# dtype-independent: nine stores serve twelve keys. `SubArray{...}` below is +# `SubArray{Int64,1,Vector{Int64},Tuple{UnitRange{Int64}},true}`. + +const COMBOS = [ + ( + 1, + "store_ns_col_direct", + [KEY_NS_COL_DIRECT_F64, KEY_NS_COL_DIRECT_F32], + "SMC_NONSYMMETRIC", + "SMC_COLUMN", + "SMC_DIRECT", + "both", + "ColumnColoringResult{SparseMatrixCSC{Float64,Int64}, Int64, BipartiteGraph{Int64}, Vector{Int64}, Vector{SubArray{...}}, Vector{Int64}, Nothing}", + ), + ( + 2, + "store_ns_row_direct", + [KEY_NS_ROW_DIRECT_F64, KEY_NS_ROW_DIRECT_F32], + "SMC_NONSYMMETRIC", + "SMC_ROW", + "SMC_DIRECT", + "both", + "RowColoringResult{SparseMatrixCSC{Float64,Int64}, Int64, BipartiteGraph{Int64}, Vector{Int64}, Vector{SubArray{...}}, Vector{Int64}, Nothing}", + ), + ( + 3, + "store_sym_col_direct", + [KEY_SYM_COL_DIRECT_F64, KEY_SYM_COL_DIRECT_F32], + "SMC_SYMMETRIC", + "SMC_COLUMN", + "SMC_DIRECT", + "both", + "StarSetColoringResult{SparseMatrixCSC{Float64,Int64}, Int64, AdjacencyGraph{Int64,false}, Vector{Int64}, Vector{SubArray{...}}, Vector{Int64}, Nothing}", + ), + ( + 4, + "store_sym_col_subst_f64", + [KEY_SYM_COL_SUBST_F64], + "SMC_SYMMETRIC", + "SMC_COLUMN", + "SMC_SUBSTITUTION", + "SMC_FLOAT64", + "TreeSetColoringResult{SparseMatrixCSC{Float64,Int64}, Int64, AdjacencyGraph{Int64,false}, Vector{SubArray{...}}, Float64}", + ), + ( + 5, + "store_sym_col_subst_f32", + [KEY_SYM_COL_SUBST_F32], + "SMC_SYMMETRIC", + "SMC_COLUMN", + "SMC_SUBSTITUTION", + "SMC_FLOAT32", + "TreeSetColoringResult{SparseMatrixCSC{Float64,Int64}, Int64, AdjacencyGraph{Int64,false}, Vector{SubArray{...}}, Float32}", + ), + ( + 6, + "store_ns_bid_direct_f64", + [KEY_NS_BID_DIRECT_F64], + "SMC_NONSYMMETRIC", + "SMC_BIDIRECTIONAL", + "SMC_DIRECT", + "SMC_FLOAT64", + "BicoloringResult{SparseMatrixCSC{Float64,Int64}, Int64, AdjacencyGraph{Int64,true}, :direct, Vector{SubArray{...}}, StarSetColoringResult{SparsityPatternCSC{Int64}, Int64, AdjacencyGraph{Int64,true}, Vector{Int64}, Vector{SubArray{...}}, Vector{Int64}, Nothing}, Float64}", + ), + ( + 7, + "store_ns_bid_direct_f32", + [KEY_NS_BID_DIRECT_F32], + "SMC_NONSYMMETRIC", + "SMC_BIDIRECTIONAL", + "SMC_DIRECT", + "SMC_FLOAT32", + "BicoloringResult{SparseMatrixCSC{Float64,Int64}, Int64, AdjacencyGraph{Int64,true}, :direct, Vector{SubArray{...}}, StarSetColoringResult{SparsityPatternCSC{Int64}, Int64, AdjacencyGraph{Int64,true}, Vector{Int64}, Vector{SubArray{...}}, Vector{Int64}, Nothing}, Float32}", + ), + ( + 8, + "store_ns_bid_subst_f64", + [KEY_NS_BID_SUBST_F64], + "SMC_NONSYMMETRIC", + "SMC_BIDIRECTIONAL", + "SMC_SUBSTITUTION", + "SMC_FLOAT64", + "BicoloringResult{SparseMatrixCSC{Float64,Int64}, Int64, AdjacencyGraph{Int64,true}, :substitution, Vector{SubArray{...}}, TreeSetColoringResult{SparsityPatternCSC{Int64}, Int64, AdjacencyGraph{Int64,true}, Vector{SubArray{...}}, Float64}, Float64}", + ), + ( + 9, + "store_ns_bid_subst_f32", + [KEY_NS_BID_SUBST_F32], + "SMC_NONSYMMETRIC", + "SMC_BIDIRECTIONAL", + "SMC_SUBSTITUTION", + "SMC_FLOAT32", + "BicoloringResult{SparseMatrixCSC{Float64,Int64}, Int64, AdjacencyGraph{Int64,true}, :substitution, Vector{SubArray{...}}, TreeSetColoringResult{SparsityPatternCSC{Int64}, Int64, AdjacencyGraph{Int64,true}, Vector{SubArray{...}}, Float32}, Float32}", + ), +] + +# Every other combination is rejected with -2: `(nonsymmetric, column|row, +# substitution)` and any symmetric row or bidirectional partition are not +# `ColoringProblem`s that SparseMatrixColorings supports. +const SUPPORTED_KEYS = [k for combo in COMBOS for k in combo[3]] diff --git a/interfaces/scripts/generate_header.jl b/interfaces/scripts/generate_header.jl new file mode 100644 index 00000000..4c0bb3cb --- /dev/null +++ b/interfaces/scripts/generate_header.jl @@ -0,0 +1,1130 @@ +#!/usr/bin/env julia +# Generate interfaces/include/smc.h and interfaces/include/smc.f90 from the +# function_sigs table in LibSMC.jl and the enum tables in coloring_table.jl, so +# that the C and the Fortran binding cannot drift apart. Dependency-free: when +# either input cannot be loaded it warns and falls back to the built-in tables +# below, which must produce byte-identical output (CI regenerates and diffs). +# +# Usage: julia interfaces/scripts/generate_header.jl + +const LIBSMC_PATH = normpath(joinpath(@__DIR__, "..", "src", "LibSMC.jl")) +const COLORING_TABLE_PATH = normpath(joinpath(@__DIR__, "coloring_table.jl")) +const PROJECT_TOML_PATH = normpath(joinpath(@__DIR__, "..", "..", "Project.toml")) +const OUT_PATH = normpath(joinpath(@__DIR__, "..", "include", "smc.h")) +const OUT_PATH_F90 = normpath(joinpath(@__DIR__, "..", "include", "smc.f90")) + +# Version parsed straight out of Project.toml, so the package need not load. +function project_version(path) + for line in eachline(path) + startswith(strip(line), '[') && break # only the top-level table + m = match(r"^\s*version\s*=\s*\"([^\"]+)\"", line) + m === nothing || return VersionNumber(m.captures[1]) + end + return error("no `version = \"...\"` entry found in $path") +end + +const _SV = project_version(PROJECT_TOML_PATH) + +# Enumerators: (c_type_name, [candidate names in coloring_table.jl], doc, +# [(name, value)]). The values are the canonical ABI and must never move. +const ENUMS = [ + ( + "SmcDataType", + [:DTYPES, :DATA_TYPES, :SMC_DTYPES], + "Element type of the numerical buffers passed to smc_compress and\n" * + "smc_decompress (double or float). The sparsity pattern is always int.", + [("SMC_FLOAT64", 0), ("SMC_FLOAT32", 1)], + ), + ( + "SmcStructure", + [:STRUCTURES, :SMC_STRUCTURES], + "Structure of the matrix. SMC_SYMMETRIC states that the sparsity pattern\n" * + "is symmetric and selects the symmetric coloring problems.", + [("SMC_NONSYMMETRIC", 0), ("SMC_SYMMETRIC", 1)], + ), + ( + "SmcPartition", + [:PARTITIONS, :SMC_PARTITIONS], + "Which dimension is colored. SMC_BIDIRECTIONAL colors rows and columns at\n" * + "the same time and produces two compressed matrices.", + [("SMC_COLUMN", 0), ("SMC_ROW", 1), ("SMC_BIDIRECTIONAL", 2)], + ), + ( + "SmcDecompression", + [:DECOMPRESSIONS, :SMC_DECOMPRESSIONS], + "How the nonzeros are recovered from the compressed matrix.\n" * + "SMC_SUBSTITUTION needs fewer colors but is only available for the\n" * + "symmetric-column and bidirectional problems.", + [("SMC_DIRECT", 0), ("SMC_SUBSTITUTION", 1)], + ), + ( + "SmcOrder", + [:ORDERS, :SMC_ORDERS], + "Vertex order used by the greedy coloring algorithm.\n" * + "RandomOrder is deliberately not exposed by this interface.", + [ + ("SMC_NATURAL", 0), + ("SMC_LARGEST_FIRST", 1), + ("SMC_SMALLEST_LAST", 2), + ("SMC_INCIDENCE_DEGREE", 3), + ("SMC_DYNAMIC_LARGEST_FIRST", 4), + ], + ), +] + +# SmcColoringOptions. Mirrored field for field, in this exact order, by the +# isbits struct in src/c_enums.jl. +const OPTION_FIELDS = [ + ("int", "structure", "SmcStructure - default SMC_NONSYMMETRIC"), + ("int", "partition", "SmcPartition - default SMC_COLUMN"), + ("int", "decompression", "SmcDecompression - default SMC_DIRECT"), + ("int", "order", "SmcOrder - default SMC_NATURAL"), + ("int", "postprocessing", "0/1 - give the neutral color 0 to the entries that need no"), + ("int", "", " evaluation, where possible (default 0)"), + ("int", "symmetric_pattern", "0/1 - assert that the sparsity pattern is symmetric,"), + ("int", "", " skipping the symmetrization step (default 0)"), + ("int", "index_base", "0 or 1 - index base of colptr, rowval and of the group"), + ("int", "", " members returned by the queries (default 0)"), + ("int", "dtype", "SmcDataType - element type used by smc_compress and"), + ("int", "", " smc_decompress (default SMC_FLOAT64)"), +] + +# Supported (structure, partition, decompression) combinations; anything else +# is rejected with -2. +const SUPPORTED_COMBOS = [ + ("SMC_NONSYMMETRIC", "SMC_COLUMN", "SMC_DIRECT"), + ("SMC_NONSYMMETRIC", "SMC_ROW", "SMC_DIRECT"), + ("SMC_SYMMETRIC", "SMC_COLUMN", "SMC_DIRECT"), + ("SMC_SYMMETRIC", "SMC_COLUMN", "SMC_SUBSTITUTION"), + ("SMC_NONSYMMETRIC", "SMC_BIDIRECTIONAL", "SMC_DIRECT"), + ("SMC_NONSYMMETRIC", "SMC_BIDIRECTIONAL", "SMC_SUBSTITUTION"), +] + +# Fallback prototype table, used when LibSMC.jl cannot be loaded; kept in sync +# with LibSMC.function_sigs by hand, and any disagreement is a hard error. +# Each entry: (c_name, return_type, [(arg_name, c_type), ...]) +const FALLBACK_FUNCTION_SIGS = Tuple{String,String,Vector{Tuple{String,String}}}[ + ("smc_default_options", "SmcColoringOptions", []), + ("smc_version", "void", [("major", "int*"), ("minor", "int*"), ("patch", "int*")]), + ( + "smc_coloring", + "int", + [ + ("m", "int"), + ("n", "int"), + ("colptr", "const int*"), + ("rowval", "const int*"), + ("opts", "const SmcColoringOptions*"), + ("result_out", "void**"), + ], + ), + ( + "smc_fast_coloring", + "int", + [ + ("m", "int"), + ("n", "int"), + ("colptr", "const int*"), + ("rowval", "const int*"), + ("opts", "const SmcColoringOptions*"), + ("row_colors", "int*"), + ("column_colors", "int*"), + ("ncolors_out", "int*"), + ], + ), + ("smc_result_free", "int", [("result", "void*")]), + ("smc_ncolors", "int", [("result", "void*"), ("ncolors_out", "int*")]), + ("smc_column_colors", "int", [("result", "void*"), ("colors", "int*"), ("len", "int")]), + ("smc_row_colors", "int", [("result", "void*"), ("colors", "int*"), ("len", "int")]), + ("smc_ncolumn_groups", "int", [("result", "void*"), ("ngroups_out", "int*")]), + ("smc_nrow_groups", "int", [("result", "void*"), ("ngroups_out", "int*")]), + ( + "smc_column_group_size", + "int", + [("result", "void*"), ("group", "int"), ("size_out", "int*")], + ), + ( + "smc_column_group", + "int", + [("result", "void*"), ("group", "int"), ("members", "int*"), ("len", "int")], + ), + ( + "smc_row_group_size", + "int", + [("result", "void*"), ("group", "int"), ("size_out", "int*")], + ), + ( + "smc_row_group", + "int", + [("result", "void*"), ("group", "int"), ("members", "int*"), ("len", "int")], + ), + ("smc_nnz", "int", [("result", "void*"), ("nnz_out", "int*")]), + ("smc_size", "int", [("result", "void*"), ("m_out", "int*"), ("n_out", "int*")]), + ( + "smc_compressed_size", + "int", + [ + ("result", "void*"), + ("Br_rows", "int*"), + ("Br_cols", "int*"), + ("Bc_rows", "int*"), + ("Bc_cols", "int*"), + ], + ), + ( + "smc_compress", + "int", + [ + ("result", "void*"), + ("nzval", "const void*"), + ("nzval_len", "size_t"), + ("Br", "void*"), + ("Br_len", "size_t"), + ("Bc", "void*"), + ("Bc_len", "size_t"), + ], + ), + ( + "smc_decompress", + "int", + [ + ("result", "void*"), + ("Br", "const void*"), + ("Br_len", "size_t"), + ("Bc", "const void*"), + ("Bc_len", "size_t"), + ("A_out", "void*"), + ("A_len", "size_t"), + ], + ), +] + +# Per-function documentation, emitted as a C comment before each prototype. +const FUNCTION_DOCS = Dict{String,String}( + "smc_default_options" => + "Return an SmcColoringOptions filled with the defaults: nonsymmetric\n" * + "structure, column partition, direct decompression, natural order, no\n" * + "postprocessing, no symmetric-pattern assertion, 0-based indices and\n" * + "SMC_FLOAT64. Always initialise an options struct with this call before\n" * + "overriding individual fields.", + "smc_version" => + "Write the SparseMatrixColorings.jl version of this library into\n" * + "*major, *minor, *patch (the same values as the SMC_VERSION_* macros).", + "smc_coloring" => + "Color the m-by-n sparsity pattern given in CSC form and return an opaque\n" * + "result handle through *result_out. Only the structure is needed here;\n" * + "the numerical values are passed later to smc_compress.\n" * + " m, n : number of rows and columns, both > 0\n" * + " colptr : n+1 column pointers, in opts->index_base\n" * + " rowval : row indices of the nonzeros, in opts->index_base,\n" * + " length colptr[n] - colptr[0]\n" * + " opts : coloring options, or NULL for smc_default_options()\n" * + " result_out : receives the handle; release it with smc_result_free\n" * + "Returns 0, -1 on an internal error, -2 if the combination of structure,\n" * + "partition, decompression and dtype is unsupported, -3 on an invalid\n" * + "argument.", + "smc_fast_coloring" => + "Color the pattern and write the colors directly, without allocating a\n" * + "handle. Convenient when only the colors are needed; the groups and the\n" * + "compression helpers require smc_coloring instead.\n" * + " row_colors : length-m buffer, may be NULL when the partition\n" * + " produces no row coloring (SMC_COLUMN)\n" * + " column_colors : length-n buffer, may be NULL when the partition\n" * + " produces no column coloring (SMC_ROW)\n" * + " ncolors_out : receives the number of colors\n" * + "SMC_BIDIRECTIONAL fills both buffers, so neither may be NULL.\n" * + "Colors are labels in 1..ncolors; 0 marks an entry that needs no\n" * + "evaluation and can only appear when opts->postprocessing is 1. Color\n" * + "labels are never shifted by opts->index_base.\n" * + "Returns 0, -1 on an internal error, -2 on an unsupported combination,\n" * + "-3 on an invalid argument.", + "smc_result_free" => + "Release a handle returned by smc_coloring; it must not be used again.\n" * + "Returns 0, or -4 if the handle is unknown (freeing twice is safe).", + "smc_ncolors" => + "Write the total number of colors of the result into *ncolors_out.\n" * + "Returns 0, -3 on an invalid argument, -4 on an invalid handle.", + "smc_column_colors" => + "Copy the color of every column into `colors`; `len` must be at least n.\n" * + "Colors are labels in 1..ncolors, 0 meaning \"no evaluation needed\".\n" * + "Returns 0, -2 if the partition has no column coloring, -3 on an invalid\n" * + "argument (including len < n), -4 on an invalid handle.", + "smc_row_colors" => + "Copy the color of every row into `colors`; `len` must be at least m.\n" * + "Colors are labels in 1..ncolors, 0 meaning \"no evaluation needed\".\n" * + "Returns 0, -2 if the partition has no row coloring, -3 on an invalid\n" * + "argument (including len < m), -4 on an invalid handle.", + "smc_ncolumn_groups" => + "Write the number of column groups into *ngroups_out. Groups are the\n" * + "color classes: group g holds every column colored g.\n" * + "Returns 0, -2 if the partition has no column coloring, -3 on an invalid\n" * + "argument, -4 on an invalid handle.", + "smc_nrow_groups" => + "Write the number of row groups into *ngroups_out.\n" * + "Returns 0, -2 if the partition has no row coloring, -3 on an invalid\n" * + "argument, -4 on an invalid handle.", + "smc_column_group_size" => + "Write the number of columns in column group `group` into *size_out.\n" * + "`group` is 1-based and runs over 1..smc_ncolumn_groups, independently of\n" * + "opts->index_base. Query the size first, then fetch the members.\n" * + "Returns 0, -2 if the partition has no column coloring, -3 on an invalid\n" * + "argument (including an out-of-range group), -4 on an invalid handle.", + "smc_column_group" => + "Copy the column indices of column group `group` into `members`; `len`\n" * + "must be at least smc_column_group_size(result, group). The indices are\n" * + "written in opts->index_base.\n" * + "Returns 0, -2 if the partition has no column coloring, -3 on an invalid\n" * + "argument (including len too small), -4 on an invalid handle.", + "smc_row_group_size" => + "Write the number of rows in row group `group` into *size_out. `group`\n" * + "is 1-based and runs over 1..smc_nrow_groups.\n" * + "Returns 0, -2 if the partition has no row coloring, -3 on an invalid\n" * + "argument (including an out-of-range group), -4 on an invalid handle.", + "smc_row_group" => + "Copy the row indices of row group `group` into `members`; `len` must be\n" * + "at least smc_row_group_size(result, group). The indices are written in\n" * + "opts->index_base.\n" * + "Returns 0, -2 if the partition has no row coloring, -3 on an invalid\n" * + "argument (including len too small), -4 on an invalid handle.", + "smc_nnz" => + "Write the number of stored entries of the sparsity pattern this result\n" * + "was built from into *nnz_out. That is exactly the number of elements\n" * + "`nzval` must have in smc_compress, i.e. the required nzval_len.\n" * + "Returns 0, -3 on an invalid argument, -4 on an invalid handle.", + "smc_size" => + "Write the dimensions of the matrix this result was built from into\n" * + "*m_out and *n_out. They are the lengths expected by smc_row_colors (m)\n" * + "and smc_column_colors (n), and A_out in smc_decompress must hold m*n\n" * + "elements, i.e. A_len must be at least m*n.\n" * + "Both out pointers must be non-NULL.\n" * + "Returns 0, -3 on an invalid argument, -4 on an invalid handle.", + "smc_compressed_size" => + "Report the dimensions of the compressed matrices, so the caller can size\n" * + "the buffers of smc_compress and smc_decompress.\n" * + " Bc : m-by-ncolors for a column partition, ncolors-by-n for a row\n" * + " partition, m-by-ncolumn_groups for a bidirectional one\n" * + " Br : nrow_groups-by-n, and used only by SMC_BIDIRECTIONAL; for the\n" * + " other partitions *Br_rows and *Br_cols are set to 0\n" * + "The Bc_len and Br_len arguments of smc_compress and smc_decompress must\n" * + "be at least Bc_rows*Bc_cols and Br_rows*Br_cols respectively.\n" * + "All four out pointers must be non-NULL.\n" * + "Returns 0, -3 on an invalid argument, -4 on an invalid handle.", + "smc_compress" => + "Compress the matrix into the dense buffers Br and Bc. Every buffer is\n" * + "followed by its length, counted in elements of the type selected by\n" * + "opts->dtype -- never in bytes.\n" * + " nzval, nzval_len : the CSC values, in the same order as the rowval\n" * + " given to smc_coloring; double* or float* according\n" * + " to opts->dtype. nzval_len must be at least the\n" * + " value reported by smc_nnz\n" * + " Br, Br_len : row-compressed matrix, used only by\n" * + " SMC_BIDIRECTIONAL; for the other partitions Br\n" * + " may be NULL and Br_len 0. A bidirectional result\n" * + " requires it, with Br_len at least Br_rows*Br_cols\n" * + " from smc_compressed_size\n" * + " Bc, Bc_len : column-compressed matrix; Bc_len must be at least\n" * + " Bc_rows*Bc_cols from smc_compressed_size\n" * + "Both buffers are column-major with the dimensions reported by\n" * + "smc_compressed_size: B[i,j] is B[j*rows + i].\n" * + "Returns 0, -1 on an internal error, -3 on an invalid argument (a NULL\n" * + "buffer the partition needs, or a buffer too small), -4 on an invalid\n" * + "handle.", + "smc_decompress" => + "Recover the full m-by-n dense matrix from the compressed form. Every\n" * + "buffer is followed by its length, counted in elements of the type\n" * + "selected by opts->dtype -- never in bytes.\n" * + " Br, Br_len : the buffer filled by smc_compress, used only by\n" * + " SMC_BIDIRECTIONAL; for the other partitions Br may be\n" * + " NULL and Br_len 0. A bidirectional result requires\n" * + " it, with Br_len at least Br_rows*Br_cols from\n" * + " smc_compressed_size\n" * + " Bc, Bc_len : the buffer filled by smc_compress; Bc_len must be at\n" * + " least Bc_rows*Bc_cols from smc_compressed_size\n" * + " A_out, A_len : m*n elements, column-major, of the type selected by\n" * + " opts->dtype; A_out[i,j] is A_out[j*m + i]. A_len must\n" * + " be at least m*n, with m and n from smc_size\n" * + "Entries outside the sparsity pattern are set to zero.\n" * + "Returns 0, -1 on an internal error, -3 on an invalid argument (a NULL\n" * + "buffer the partition needs, or a buffer too small), -4 on an invalid\n" * + "handle.", +) + +# Section banners, emitted just before the named function. +const SECTIONS = [ + ( + "smc_coloring", + [ + "Coloring", + "", + "The pattern is always given in CSC form, in opts->index_base. The", + "caller's arrays are copied and never modified.", + ], + ), + ( + "smc_ncolors", + [ + "Queries", + "", + "All of them take a handle from smc_coloring. Every buffer crossing", + "the interface carries its own length, that length is checked before a", + "single element is read or written, and every sizing question has a", + "query, so a caller can always ask before allocating:", + "", + " buffer length argument how to obtain the required length", + " colors len n (columns) or m (rows), from smc_size", + " members len smc_column_group_size / smc_row_group_size", + " nzval nzval_len smc_nnz", + " Bc Bc_len Bc_rows*Bc_cols, smc_compressed_size", + " Br Br_len Br_rows*Br_cols, smc_compressed_size", + " A_out A_len m*n, from smc_size", + "", + "Lengths are element counts, never byte counts. The numerical", + "buffers use size_t rather than int because A_len is m*n, which", + "overflows a 32-bit int. Too small a buffer is rejected with -3.", + ], + ), + ( + "smc_compressed_size", + [ + "Compression / decompression", + "", + "Dense matrices are column-major (Fortran / Julia order) and hold", + "double or float elements according to opts->dtype.", + ], + ), +] + +# Optional inputs: LibSMC.function_sigs and the enum tables of coloring_table.jl +function load_function_sigs() + isfile(LIBSMC_PATH) || return nothing + try + Base.include(Main, LIBSMC_PATH) + # invokelatest: the bindings only exist in a newer world than this function. + lib = Base.invokelatest(getglobal, Main, :LibSMC) + sigs = Base.invokelatest(getglobal, lib, :function_sigs) + return Tuple{String,String,Vector{Tuple{String,String}}}[ + ( + String(name), + String(ret), + Tuple{String,String}[(String(a), String(t)) for (a, t) in args], + ) for (name, ret, args) in sigs + ] + catch e + @warn "could not read function_sigs from $LIBSMC_PATH; using the built-in table" exception = + e + return nothing + end +end + +function load_coloring_table() + isfile(COLORING_TABLE_PATH) || return nothing + try + mod = Module(:SmcColoringTable) + Base.include(mod, COLORING_TABLE_PATH) + return mod + catch e + @warn "could not load $COLORING_TABLE_PATH; using the built-in enum values" exception = + e + return nothing + end +end + +# Pull a C enumerator name out of a table entry, whatever its shape (bare +# string, or a tuple / pair / vector holding one somewhere). +function enumerator_name(entry) + entry isa AbstractString && return startswith(entry, "SMC_") ? String(entry) : nothing + parts = if entry isa Pair + (entry.first, entry.second) + elseif entry isa Union{Tuple,AbstractVector} + entry + else + () + end + for x in parts + x isa AbstractString && startswith(x, "SMC_") && return String(x) + end + return nothing +end + +# Enumerators of `enum_name`, as declared by coloring_table.jl, or nothing. +function enumerators_from_table(mod, candidates) + mod === nothing && return nothing + for sym in candidates + isdefined(mod, sym) || continue + tbl = Base.invokelatest(getglobal, mod, sym) + tbl isa AbstractVector && !isempty(tbl) || continue + found = String[] + for entry in tbl + name = enumerator_name(entry) + if name === nothing + empty!(found) + break + end + push!(found, name) + end + isempty(found) || return [(name, i - 1) for (i, name) in enumerate(found)] + end + return nothing +end + +const coloring_table = load_coloring_table() +const loaded_sigs = load_function_sigs() + +# Canonical values stay authoritative: the header is the ABI, so a disagreement +# is reported instead of silently changing the generated file. +function checked_enumerators(type_name, candidates, canonical) + from_table = enumerators_from_table(coloring_table, candidates) + if from_table !== nothing && from_table != canonical + @warn "coloring_table.jl disagrees with the built-in values for $type_name; keeping the built-in ones" builtin = + canonical table = from_table + end + return canonical +end + +function checked_sigs() + loaded_sigs === nothing && return FALLBACK_FUNCTION_SIGS + if loaded_sigs != FALLBACK_FUNCTION_SIGS + # Diff the FULL signatures, not just the names: a name-only diff lets an + # arity or type change through, and the header then misdeclares the ABI to + # every C caller. Nothing else in the test suite or in CI catches that. + render(sig) = string( + sig[2], + " ", + sig[1], + "(", + join([string(t, " ", n) for (n, t) in sig[3]], ", "), + ")", + ) + by_name = Dict(s[1] => s for s in FALLBACK_FUNCTION_SIGS) + problems = String[] + for name in setdiff(first.(FALLBACK_FUNCTION_SIGS), first.(loaded_sigs)) + push!( + problems, " $name: in the built-in table but not in LibSMC.function_sigs" + ) + end + for sig in loaded_sigs + reference = get(by_name, sig[1], nothing) + if reference === nothing + push!( + problems, + " $(sig[1]): in LibSMC.function_sigs but not in the built-in table", + ) + elseif sig != reference + push!(problems, " $(sig[1]):") + push!(problems, " LibSMC: " * render(sig)) + push!(problems, " built-in: " * render(reference)) + end + end + error( + "LibSMC.function_sigs disagrees with the built-in table in generate_header.jl.\n" * + "Both describe the C ABI, so a disagreement means the header would misdeclare it.\n" * + "Reconcile them (they must match element for element), then re-run:\n" * + join(problems, "\n"), + ) + end + return loaded_sigs +end + +# The one checked ABI description, shared by the C and the Fortran emitters. +const SIGS = checked_sigs() +const ENUM_TABLES = [ + (type_name, doc, checked_enumerators(type_name, candidates, canonical)) for + (type_name, candidates, doc, canonical) in ENUMS +] + +# Emitters. + +# A C comment block: single line as /* ... */, multi-line as a /* * */ block. +function emit_doc(io, text) + lines = split(text, '\n') + if length(lines) == 1 + println(io, "/* $(lines[1]) */") + else + println(io, "/*") + for l in lines + println(io, isempty(l) ? " *" : " * $l") + end + println(io, " */") + end +end + +function emit_banner(io, lines) + println( + io, "/* -------------------------------------------------------------------------" + ) + for l in lines + println(io, isempty(l) ? " *" : " * $l") + end + return println( + io, + " * ------------------------------------------------------------------------- */", + ) +end + +function emit_enum(io, type_name, doc, entries) + emit_doc(io, doc) + println(io, "typedef enum {") + width = maximum(length(name) for (name, _) in entries) + for (i, (name, value)) in enumerate(entries) + comma = i == length(entries) ? "" : "," + println(io, " $(rpad(name, width)) = $value$comma") + end + println(io, "} $type_name;") + return println(io) +end + +function emit_options_struct(io) + println(io, "typedef struct {") + decls = [isempty(name) ? "" : "$ctype $name;" for (ctype, name, _) in OPTION_FIELDS] + dwidth = maximum(length, decls) + cwidth = maximum(length(comment) for (_, _, comment) in OPTION_FIELDS) + for ((_, _, comment), decl) in zip(OPTION_FIELDS, decls) + println(io, " $(rpad(decl, dwidth)) /* $(rpad(comment, cwidth)) */") + end + println(io, "} SmcColoringOptions;") + return println(io) +end + +# Write smc.h +mkpath(dirname(OUT_PATH)) + +open(OUT_PATH, "w") do io + println( + io, + """ +#ifndef SMC_H +#define SMC_H + +#include /* size_t */ + +/* Version */ +#define SMC_VERSION_MAJOR $(_SV.major) +#define SMC_VERSION_MINOR $(_SV.minor) +#define SMC_VERSION_PATCH $(_SV.patch) + +#ifdef __cplusplus +extern "C" { +#endif +""", + ) + + emit_banner( + io, + [ + "libsmc - C interface to SparseMatrixColorings.jl", + "", + "Typical use:", + "", + " SmcColoringOptions opts = smc_default_options();", + " opts.structure = SMC_NONSYMMETRIC;", + " opts.partition = SMC_COLUMN;", + " opts.order = SMC_LARGEST_FIRST;", + "", + " void *result;", + " if (smc_coloring(m, n, colptr, rowval, &opts, &result) != 0) { ... }", + "", + " int nc;", + " smc_ncolors(result, &nc);", + " int *colors = malloc(n * sizeof(int));", + " smc_column_colors(result, colors, n);", + "", + " int Br_rows, Br_cols, Bc_rows, Bc_cols;", + " smc_compressed_size(result, &Br_rows, &Br_cols, &Bc_rows, &Bc_cols);", + " size_t Bc_len = (size_t) Bc_rows * (size_t) Bc_cols;", + " double *Bc = malloc(Bc_len * sizeof(double));", + "", + " int nnz;", + " smc_nnz(result, &nnz);", + " smc_compress(result, nzval, (size_t) nnz, NULL, 0, Bc, Bc_len);", + "", + " smc_result_free(result);", + "", + "The sparsity pattern is passed in compressed sparse column form: colptr", + "has n+1 entries, rowval has colptr[n] - colptr[0] entries, and both use", + "the index base selected by opts.index_base (0 by default). The caller's", + "arrays are copied, never modified. Coloring is structure-only: the", + "numerical values are needed only by smc_compress.", + "", + "Indices crossing the interface are 32-bit int; matrices with more than", + "2^31 nonzeros are out of scope. Dense matrices are column-major, with", + "double or float elements according to opts.dtype.", + "", + "Every output buffer is caller-allocated and every buffer argument is", + "immediately followed by its length, counted in elements, never in bytes.", + ], + ) + println(io) + + emit_banner(io, ["Enumerators"]) + println(io) + for (type_name, doc, entries) in ENUM_TABLES + emit_enum(io, type_name, doc, entries) + end + + combo_lines = [" $(rpad(s, 16)) $(rpad(p, 17)) $d" for (s, p, d) in SUPPORTED_COMBOS] + emit_banner( + io, + [ + "Coloring options", + "", + "Passed to smc_coloring and smc_fast_coloring, and remembered by the", + "result handle. Initialise with smc_default_options() before overriding", + "individual fields; a NULL options pointer means the defaults.", + "", + "Supported (structure, partition, decompression) combinations; anything", + "else is rejected with -2:", + combo_lines..., + ], + ) + println(io) + emit_options_struct(io) + + emit_banner( + io, + [ + "Return codes", + "", + "Every function returning int returns one of:", + "", + " 0 success", + " -1 internal error (a Julia exception was caught and logged)", + " -2 unsupported combination of (structure, partition, decompression,", + " dtype)", + " -3 invalid argument (NULL pointer, bad dimension, buffer too small,", + " bad enum value, bad index_base)", + " -4 invalid or already-freed handle", + ], + ) + println(io) + + emit_banner(io, ["API functions"]) + println(io) + + sections = Dict(SECTIONS) + for (name, ret, args) in SIGS + if haskey(sections, name) + emit_banner(io, sections[name]) + println(io) + end + if haskey(FUNCTION_DOCS, name) + emit_doc(io, FUNCTION_DOCS[name]) + else + @warn "no documentation for $name in FUNCTION_DOCS; emitting a bare prototype" + end + arg_str = if isempty(args) + "void" + else + join(["$ctype $aname" for (aname, ctype) in args], ", ") + end + println(io, "$ret $name($arg_str);") + println(io) + end + + return println( + io, + """ +#ifdef __cplusplus +} +#endif + +#endif /* SMC_H */""", + ) +end + +println("Generated $OUT_PATH") + +# =========================================================================== +# Fortran binding (include/smc.f90), emitted from SIGS and ENUM_TABLES like +# smc.h above. Following Krylov.jl it is an INCLUDE FILE rather than a module +# (`use iso_c_binding`, `implicit none`, then `include 'smc.f90'`), which +# avoids shipping compiler-specific .mod files. +# =========================================================================== + +# C-to-Fortran type mapping. Every C pointer becomes a `type(c_ptr), value` +# that the caller fills with c_loc(x) or c_null_ptr; the only exception is the +# `void**` out-parameter, which becomes an `intent(out)` c_ptr. +# +# `smc_version`'s three `int*` outputs are instead plain `integer(c_int), +# intent(out)` scalars, so a caller writes `call smc_version(major, minor, +# patch)`; Fortran passes scalars by reference, so this is the same ABI. It is +# a per-argument override rather than a blanket `int* -> intent(out)` rule +# because `int*` is also used for output *arrays* (`colors`, `members`), which +# must stay `type(c_ptr)` so the caller can pass c_loc of an array section. +const FORTRAN_ARG_OVERRIDES = Dict{Tuple{String,String},Tuple{String,String}}( + ("smc_version", "major") => ("integer(c_int)", "intent(out)"), + ("smc_version", "minor") => ("integer(c_int)", "intent(out)"), + ("smc_version", "patch") => ("integer(c_int)", "intent(out)"), +) + +function fortran_arg_type(ctype, fname="", argname="") + override = get(FORTRAN_ARG_OVERRIDES, (fname, argname), nothing) + override === nothing || return override + ctype == "int" && return ("integer(c_int)", "value") + ctype == "size_t" && return ("integer(c_size_t)", "value") + endswith(ctype, "**") && return ("type(c_ptr)", "intent(out)") + endswith(ctype, "*") && return ("type(c_ptr)", "value") + return error("no Fortran mapping for the C argument type `$ctype`") +end + +# Return type: nothing for `void` (a subroutine), else (ftype, result name). +function fortran_return_type(ctype) + ctype == "void" && return nothing + ctype == "int" && return ("integer(c_int)", "ret") + ctype == "SmcColoringOptions" && return ("type(SmcColoringOptions)", "opts") + return error("no Fortran mapping for the C return type `$ctype`") +end + +# Per-function documentation for the Fortran binding: shorter and +# Fortran-flavoured (c_loc / c_null_ptr / opts%field) than FUNCTION_DOCS. +const FORTRAN_DOCS = Dict{String,String}( + "smc_default_options" => + "Return an SmcColoringOptions filled with the defaults: nonsymmetric\n" * + "structure, column partition, direct decompression, natural order, no\n" * + "postprocessing, no symmetric-pattern assertion, 0-based indices and\n" * + "SMC_FLOAT64. Always start from this call, override the fields you\n" * + "need, then pass c_loc(opts).", + "smc_version" => + "Write the SparseMatrixColorings.jl version of this library into major,\n" * + "minor and patch (the same values as the SMC_VERSION_* parameters).\n" * + "Pass c_loc of three integer(c_int), target scalars.", + "smc_coloring" => + "Color the m-by-n sparsity pattern given in CSC form and return an\n" * + "opaque result handle through result_out.\n" * + " m, n : number of rows and columns, both > 0\n" * + " colptr : c_loc of n+1 column pointers, in opts%index_base\n" * + " rowval : c_loc of the row indices of the nonzeros, in\n" * + " opts%index_base, length colptr(n+1) - colptr(1)\n" * + " opts : c_loc(options), or c_null_ptr for the defaults\n" * + " result_out : receives the handle; release it with smc_result_free\n" * + "Returns 0, -1 internal error, -2 unsupported combination, -3 invalid\n" * + "argument.", + "smc_fast_coloring" => + "Color the pattern and write the colors directly, without allocating a\n" * + "handle. The groups and the compression helpers need smc_coloring.\n" * + " row_colors : c_loc of a length-m buffer, c_null_ptr when the\n" * + " partition produces no row coloring (SMC_COLUMN)\n" * + " column_colors : c_loc of a length-n buffer, c_null_ptr when the\n" * + " partition produces no column coloring (SMC_ROW)\n" * + " ncolors_out : c_loc of a scalar receiving the number of colors\n" * + "SMC_BIDIRECTIONAL fills both buffers, so neither may be c_null_ptr.\n" * + "Colors are labels in 1..ncolors; 0 marks an entry that needs no\n" * + "evaluation and can only appear when opts%postprocessing is 1.\n" * + "Returns 0, -1 internal error, -2 unsupported combination, -3 invalid\n" * + "argument.", + "smc_result_free" => + "Release a handle returned by smc_coloring; it must not be used again.\n" * + "Returns 0, or -4 if the handle is unknown (freeing twice is safe).", + "smc_ncolors" => + "Write the total number of colors into the scalar pointed to by\n" * + "ncolors_out. Returns 0, -3 invalid argument, -4 invalid handle.", + "smc_column_colors" => + "Copy the color of every column into colors; len must be at least n.\n" * + "Colors are labels in 1..ncolors, 0 meaning \"no evaluation needed\".\n" * + "Returns 0, -2 if the partition has no column coloring, -3 invalid\n" * + "argument (including len < n), -4 invalid handle.", + "smc_row_colors" => + "Copy the color of every row into colors; len must be at least m.\n" * + "Colors are labels in 1..ncolors, 0 meaning \"no evaluation needed\".\n" * + "Returns 0, -2 if the partition has no row coloring, -3 invalid\n" * + "argument (including len < m), -4 invalid handle.", + "smc_ncolumn_groups" => + "Write the number of column groups into ngroups_out. Groups are the\n" * + "color classes: group g holds every column colored g.\n" * + "Returns 0, -2 if the partition has no column coloring, -3 invalid\n" * + "argument, -4 invalid handle.", + "smc_nrow_groups" => + "Write the number of row groups into ngroups_out.\n" * + "Returns 0, -2 if the partition has no row coloring, -3 invalid\n" * + "argument, -4 invalid handle.", + "smc_column_group_size" => + "Write the number of columns in column group `group` into size_out.\n" * + "`group` is 1-based and runs over 1..smc_ncolumn_groups, independently\n" * + "of opts%index_base. Query the size first, then fetch the members.\n" * + "Returns 0, -2 if the partition has no column coloring, -3 invalid\n" * + "argument (including an out-of-range group), -4 invalid handle.", + "smc_column_group" => + "Copy the column indices of column group `group` into members; len must\n" * + "be at least smc_column_group_size(result, group, ...). The indices are\n" * + "written in opts%index_base.\n" * + "Returns 0, -2 if the partition has no column coloring, -3 invalid\n" * + "argument (including len too small), -4 invalid handle.", + "smc_row_group_size" => + "Write the number of rows in row group `group` into size_out. `group`\n" * + "is 1-based and runs over 1..smc_nrow_groups.\n" * + "Returns 0, -2 if the partition has no row coloring, -3 invalid\n" * + "argument (including an out-of-range group), -4 invalid handle.", + "smc_row_group" => + "Copy the row indices of row group `group` into members; len must be at\n" * + "least smc_row_group_size(result, group, ...). The indices are written\n" * + "in opts%index_base.\n" * + "Returns 0, -2 if the partition has no row coloring, -3 invalid\n" * + "argument (including len too small), -4 invalid handle.", + "smc_nnz" => + "Write the number of stored entries of the sparsity pattern this result\n" * + "was built from into nnz_out. That is exactly the required nzval_len\n" * + "of smc_compress.\n" * + "Returns 0, -3 invalid argument, -4 invalid handle.", + "smc_size" => + "Write the dimensions of the matrix this result was built from into\n" * + "m_out and n_out: the lengths expected by smc_row_colors (m) and\n" * + "smc_column_colors (n), and A_len must be at least m*n.\n" * + "Both pointers must be non-NULL.\n" * + "Returns 0, -3 invalid argument, -4 invalid handle.", + "smc_compressed_size" => + "Report the dimensions of the compressed matrices, so the caller can\n" * + "size the buffers of smc_compress and smc_decompress.\n" * + " Bc : m-by-ncolors for a column partition, ncolors-by-n for a row\n" * + " partition, m-by-ncolumn_groups for a bidirectional one\n" * + " Br : nrow_groups-by-n, used only by SMC_BIDIRECTIONAL; for the other\n" * + " partitions Br_rows and Br_cols are set to 0\n" * + "All four pointers must be non-NULL.\n" * + "Returns 0, -3 invalid argument, -4 invalid handle.", + "smc_compress" => + "Compress the matrix into the dense buffers Br and Bc. Every buffer is\n" * + "followed by its length, counted in elements of the type selected by\n" * + "opts%dtype -- never in bytes.\n" * + " nzval, nzval_len : c_loc of the CSC values, in the same order as the\n" * + " rowval given to smc_coloring, real(c_double) or\n" * + " real(c_float) according to opts%dtype; nzval_len\n" * + " at least smc_nnz\n" * + " Br, Br_len : row-compressed matrix, used only by\n" * + " SMC_BIDIRECTIONAL; otherwise c_null_ptr and 0\n" * + " Bc, Bc_len : column-compressed matrix, at least Bc_rows*Bc_cols\n" * + "Both buffers are column-major with the dimensions reported by\n" * + "smc_compressed_size, which is Fortran's own layout: B(i,j).\n" * + "Returns 0, -1 internal error, -3 invalid argument (a c_null_ptr the\n" * + "partition needs, or a buffer too small), -4 invalid handle.", + "smc_decompress" => + "Recover the full m-by-n dense matrix from the compressed form. Every\n" * + "buffer is followed by its length, counted in elements of the type\n" * + "selected by opts%dtype -- never in bytes.\n" * + " Br, Br_len : the buffer filled by smc_compress, used only by\n" * + " SMC_BIDIRECTIONAL; otherwise c_null_ptr and 0\n" * + " Bc, Bc_len : the buffer filled by smc_compress, at least\n" * + " Bc_rows*Bc_cols from smc_compressed_size\n" * + " A_out, A_len : m*n elements, column-major, of the type selected by\n" * + " opts%dtype; A_len at least m*n, with m and n from\n" * + " smc_size\n" * + "Entries outside the sparsity pattern are set to zero.\n" * + "Returns 0, -1 internal error, -3 invalid argument (a c_null_ptr the\n" * + "partition needs, or a buffer too small), -4 invalid handle.", +) + +const F_RULE = "-------------------------------------------------------------------------" + +# Section banners are shared with the C header, which writes `opts->dtype`; +# rewriting to `opts%dtype` avoids a second copy of the prose that could drift. +f_prose(line) = replace(line, "opts->" => "opts%") + +f_comment(indent, line) = isempty(line) ? "$(indent)!" : "$(indent)! $(f_prose(line))" + +function emit_f_doc(io, indent, text) + for l in split(text, '\n') + println(io, f_comment(indent, l)) + end +end + +function emit_f_banner(io, indent, lines) + println(io, f_comment(indent, F_RULE)) + for l in lines + println(io, f_comment(indent, l)) + end + return println(io, f_comment(indent, F_RULE)) +end + +# Wrap `head(a, b, c)` over several `&`-continued lines of at most `width` +# characters, aligned under the opening parenthesis as in krylov.f90. +function wrapped_call(head, argnames, tail; width=92) + open_col = length(head) + 1 + isempty(argnames) && return [head * "()" * tail] + lines = String[] + current = head * "(" + for (i, a) in enumerate(argnames) + piece = i == length(argnames) ? a : a * ", " + # + 2 for the trailing " &" that a continued line needs + if length(current) + length(piece) + 2 > width && current != head * "(" + push!(lines, current * "&") + current = " "^open_col + end + current *= piece + end + push!(lines, current * ")" * tail) + return lines +end + +# One interface body: `function`/`subroutine` statement, dummy argument +# declarations, result declaration, closing `end`. +function emit_f_interface(io, name, ret, args) + indent = " " + body = " " + retinfo = fortran_return_type(ret) + kind = retinfo === nothing ? "subroutine" : "function" + + # Group consecutive arguments sharing a Fortran type and attribute. + groups = Tuple{String,String,Vector{String}}[] + for (aname, ctype) in args + ftype, attr = fortran_arg_type(ctype, name, aname) + if !isempty(groups) && groups[end][1] == ftype && groups[end][2] == attr + push!(groups[end][3], aname) + else + push!(groups, (ftype, attr, String[aname])) + end + end + + twidth = isempty(groups) ? 0 : maximum(length(ftype) + 1 for (ftype, _, _) in groups) + awidth = isempty(groups) ? 0 : maximum(length(attr) for (_, attr, _) in groups) + + # `function foo(a, b) &` / ` bind(c, name='foo') result(ret)` + for l in wrapped_call("$(indent)$kind $name", [a for (a, _) in args], " &") + println(io, l) + end + suffix = retinfo === nothing ? "" : " result($(retinfo[2]))" + println(io, "$(indent) bind(c, name='$name')$suffix") + + # `use` first, then `import`, as the standard requires. + isempty(args) || println(io, "$(body)use iso_c_binding") + if retinfo !== nothing && startswith(retinfo[1], "type(Smc") + println(io, "$(body)import :: SmcColoringOptions") + end + for (ftype, attr, names) in groups + println( + io, + "$(body)$(rpad(ftype * ",", twidth)) $(rpad(attr, awidth)) :: $(join(names, ", "))", + ) + end + if retinfo !== nothing + println(io, "$(body)$(rpad(retinfo[1], twidth + 1 + awidth)) :: $(retinfo[2])") + end + return println(io, "$(indent)end $kind $name") +end + +open(OUT_PATH_F90, "w") do io + println( + io, + """ +! smc.f90 - Fortran interface to SparseMatrixColorings.jl +! +! Generated by interfaces/scripts/generate_header.jl from the same table as +! smc.h -- do not edit by hand, edit the generator instead. +! +! An include file rather than a module, so that no .mod file has to be shipped +! and any Fortran compiler can consume it: +! +! program my_prog +! use iso_c_binding +! implicit none +! include 'smc.f90' ! <- here, after implicit none +! ... +! end program +! +! Every C pointer is a type(c_ptr), value dummy argument. Pass c_loc(x) +! for an array or a struct you own -- it must carry the target attribute -- +! or c_null_ptr where the C interface accepts NULL. The single exception is +! the void** out-parameter of smc_coloring, declared type(c_ptr), +! intent(out), which receives the opaque result handle. +! +! Dense matrices are column-major, which is already Fortran's own layout, so +! a 2D array can be handed over directly with c_loc. Buffer lengths are +! element counts, never byte counts.""", + ) + + println(io) + println(io, " ! Version") + for (suffix, value) in + [("MAJOR", _SV.major), ("MINOR", _SV.minor), ("PATCH", _SV.patch)] + println(io, " integer(c_int), parameter :: SMC_VERSION_$suffix = $value") + end + println(io) + + emit_f_banner(io, " ", ["Enumerators (must match smc.h)"]) + for (type_name, doc, entries) in ENUM_TABLES + println(io) + println(io, " ! $type_name") + emit_f_doc(io, " ", doc) + width = maximum(length(name) for (name, _) in entries) + for (name, value) in entries + println(io, " integer(c_int), parameter :: $(rpad(name, width)) = $value") + end + end + println(io) + + combo_lines = [" $(rpad(s, 16)) $(rpad(p, 17)) $d" for (s, p, d) in SUPPORTED_COMBOS] + emit_f_banner( + io, + " ", + [ + "Coloring options (must match the struct in smc.h)", + "", + "Passed to smc_coloring and smc_fast_coloring as c_loc(opts), and", + "remembered by the result handle. Initialise with smc_default_options()", + "before overriding individual fields; c_null_ptr means the defaults.", + "", + "Supported (structure, partition, decompression) combinations; anything", + "else is rejected with -2:", + combo_lines..., + ], + ) + println(io) + + # The 8 fields in the exact order of the C struct; continuation lines of the + # per-field comments have an empty name in OPTION_FIELDS. + nfields = count(!isempty(name) for (_, name, _) in OPTION_FIELDS) + nfields == 8 || error("expected 8 SmcColoringOptions fields, found $nfields") + println(io, " type, bind(c) :: SmcColoringOptions") + fdecls = [ + isempty(name) ? "" : "integer(c_int) :: $name" for (_, name, _) in OPTION_FIELDS + ] + fwidth = maximum(length, fdecls) + for ((_, _, comment), decl) in zip(OPTION_FIELDS, fdecls) + println(io, rstrip(" $(rpad(decl, fwidth)) ! $comment")) + end + println(io, " end type SmcColoringOptions") + println(io) + + emit_f_banner( + io, + " ", + [ + "Return codes", + "", + "Every function returning integer(c_int) returns one of:", + "", + " 0 success", + " -1 internal error (a Julia exception was caught and logged)", + " -2 unsupported combination of (structure, partition, decompression,", + " dtype)", + " -3 invalid argument (NULL pointer, bad dimension, buffer too small,", + " bad enum value, bad index_base)", + " -4 invalid or already-freed handle", + ], + ) + println(io) + + emit_f_banner(io, " ", ["C function interfaces"]) + println(io) + println(io, " interface") + + sections = Dict(SECTIONS) + for (i, (name, ret, args)) in enumerate(SIGS) + println(io) + if haskey(sections, name) + emit_f_banner(io, " ", sections[name]) + println(io) + end + println(io, f_comment(" ", F_RULE)) + println(io, f_comment(" ", name)) + println(io, f_comment(" ", "")) + if haskey(FORTRAN_DOCS, name) + emit_f_doc(io, " ", FORTRAN_DOCS[name]) + else + @warn "no documentation for $name in FORTRAN_DOCS; emitting a bare interface" + end + println(io, f_comment(" ", F_RULE)) + emit_f_interface(io, name, ret, args) + end + + println(io) + return println(io, " end interface") +end + +println("Generated $OUT_PATH_F90") diff --git a/interfaces/src/LibSMC.jl b/interfaces/src/LibSMC.jl new file mode 100644 index 00000000..79a49ac5 --- /dev/null +++ b/interfaces/src/LibSMC.jl @@ -0,0 +1,796 @@ +module LibSMC + +using SparseArrays +using SparseMatrixColorings + +# Matches the SMC_VERSION_* macros in smc.h; queryable at run time via smc_version. +const _SMC_VERSION = pkgversion(SparseMatrixColorings) + +include(joinpath(@__DIR__, "..", "scripts", "coloring_table.jl")) +include("c_enums.jl") +include("c_stores.jl") + +# Signatures exported to the generated C header, read by +# scripts/generate_header.jl. Each entry: (c_name, return_type, [(arg, type)]). +const function_sigs = Tuple{String,String,Vector{Tuple{String,String}}}[] + +macro export_sig(name, ret, args...) + arg_pairs = [(string(a.args[1]), string(a.args[2])) for a in args] + push!(function_sigs, (string(name), string(ret), arg_pairs)) + return esc(:(nothing)) +end + +# Only the twelve combo keys of `coloring_table.jl` have a store; every other +# well-formed combination is -2. Spelled out rather than looked up in +# `SUPPORTED_KEYS` so that no container is touched on this path. +function _supported_key(key::UInt8) + key == KEY_NS_COL_DIRECT_F64 && return true + key == KEY_NS_COL_DIRECT_F32 && return true + key == KEY_NS_ROW_DIRECT_F64 && return true + key == KEY_NS_ROW_DIRECT_F32 && return true + key == KEY_SYM_COL_DIRECT_F64 && return true + key == KEY_SYM_COL_DIRECT_F32 && return true + key == KEY_SYM_COL_SUBST_F64 && return true + key == KEY_SYM_COL_SUBST_F32 && return true + key == KEY_NS_BID_DIRECT_F64 && return true + key == KEY_NS_BID_DIRECT_F32 && return true + key == KEY_NS_BID_SUBST_F64 && return true + key == KEY_NS_BID_SUBST_F32 && return true + return false +end + +# NULL selects the documented defaults. +function _load_options(opts_ptr::Ptr{Cvoid}) + opts_ptr == C_NULL && return SMC_DEFAULT_OPTIONS + return unsafe_load(Ptr{SmcColoringOptionsC}(opts_ptr)) +end + +# Check the CSC arrays before anything reads them: `colptr` must start at the +# index base and be non-decreasing, and every row index must be inside 1..m. +# This is what makes the hand-rolled compression loops safe. +function _check_pattern(m::Int, n::Int, colptr::Ptr{Cint}, rowval::Ptr{Cint}, base::Int) + start = Int(unsafe_load(colptr, 1)) + start == base || return Cint(-3) + previous = start + @inbounds for j in 2:(n + 1) + p = Int(unsafe_load(colptr, j)) + p >= previous || return Cint(-3) + previous = p + end + nz = previous - start + # The API takes no `nnz` argument, so `nz` comes from the caller's + # `colptr[n+1]`; without this bound a garbage value reads off the end of + # `rowval`. A duplicate-free CSC pattern holds at most `m * n` entries, and + # `m * n` cannot overflow because both came from a `Cint`. + nz <= m * n || return Cint(-3) + @inbounds for k in 1:nz + i = Int(unsafe_load(rowval, k)) - base + 1 + (1 <= i <= m) || return Cint(-3) + end + return Cint(0) +end + +# Build the internal matrix directly from the caller's arrays, which are only +# read. The index base is applied exactly once, here. The values are +# irrelevant to a coloring, so they are all ones. +function _build_matrix(m::Int, n::Int, colptr::Ptr{Cint}, rowval::Ptr{Cint}, base::Int) + shift = 1 - base + cp = Vector{Int64}(undef, n + 1) + @inbounds for j in 1:(n + 1) + cp[j] = Int64(unsafe_load(colptr, j)) + shift + end + nz = Int(cp[n + 1] - cp[1]) + rv = Vector{Int64}(undef, nz) + @inbounds for k in 1:nz + rv[k] = Int64(unsafe_load(rowval, k)) + shift + end + nzv = ones(Float64, nz) + return SparseMatrixCSC{Float64,Int64}(m, n, cp, rv, nzv) +end + +# Order dispatch through a function barrier: a `Union{NaturalOrder,...}` hoisted +# into a variable defeats `--trim=safe`. `@order_barrier order impl A rest...` +# expands to an if/elseif chain calling `impl(A, , +# rest...)`, so every branch gets its own specialization. + +const _ORDER_EXPRS = ( + (:SMC_NATURAL, :(NaturalOrder())), + (:SMC_LARGEST_FIRST, :(LargestFirst())), + (:SMC_SMALLEST_LAST, :(DynamicDegreeBasedOrder{:back,:high2low,false}())), + (:SMC_INCIDENCE_DEGREE, :(DynamicDegreeBasedOrder{:back,:low2high,false}())), + (:SMC_DYNAMIC_LARGEST_FIRST, :(DynamicDegreeBasedOrder{:forward,:low2high,false}())), +) + +macro order_barrier(order, impl, matrix, rest...) + last_key, last_order = _ORDER_EXPRS[end] + chain = Expr(:call, impl, matrix, last_order, rest...) + for i in (length(_ORDER_EXPRS) - 1):-1:1 + keyname, order_expr = _ORDER_EXPRS[i] + chain = Expr( + :if, + :($order == $keyname), + Expr(:call, impl, matrix, order_expr, rest...), + chain, + ) + end + return esc(chain) +end + +# `postprocessing` is a literal in each branch; both build the same concrete +# `GreedyColoringAlgorithm` type, so the result is still statically known. +macro greedy(decompression, order, postprocessing) + return esc( + quote + if $postprocessing + GreedyColoringAlgorithm{$decompression}($order; postprocessing=true) + else + GreedyColoringAlgorithm{$decompression}($order; postprocessing=false) + end + end + ) +end + +## nonsymmetric / column / direct + +function _color_ns_col_impl(A, order, pp::Bool, sp::Bool) + algo = @greedy :direct order pp + return coloring( + A, + ColoringProblem{:nonsymmetric,:column}(), + algo; + decompression_eltype=Float64, + symmetric_pattern=sp, + ) +end + +function _color_ns_col(A, order::Cint, pp::Bool, sp::Bool) + @order_barrier order _color_ns_col_impl A pp sp +end + +function _fast_ns_col_impl(A, order, pp::Bool, sp::Bool) + algo = @greedy :direct order pp + return fast_coloring( + A, ColoringProblem{:nonsymmetric,:column}(), algo; symmetric_pattern=sp + ) +end + +function _fast_ns_col(A, order::Cint, pp::Bool, sp::Bool) + @order_barrier order _fast_ns_col_impl A pp sp +end + +## nonsymmetric / row / direct + +function _color_ns_row_impl(A, order, pp::Bool, sp::Bool) + algo = @greedy :direct order pp + return coloring( + A, + ColoringProblem{:nonsymmetric,:row}(), + algo; + decompression_eltype=Float64, + symmetric_pattern=sp, + ) +end + +function _color_ns_row(A, order::Cint, pp::Bool, sp::Bool) + @order_barrier order _color_ns_row_impl A pp sp +end + +function _fast_ns_row_impl(A, order, pp::Bool, sp::Bool) + algo = @greedy :direct order pp + return fast_coloring( + A, ColoringProblem{:nonsymmetric,:row}(), algo; symmetric_pattern=sp + ) +end + +function _fast_ns_row(A, order::Cint, pp::Bool, sp::Bool) + @order_barrier order _fast_ns_row_impl A pp sp +end + +## symmetric / column / direct + +function _color_sym_col_direct_impl(A, order, pp::Bool, sp::Bool) + algo = @greedy :direct order pp + return coloring( + A, + ColoringProblem{:symmetric,:column}(), + algo; + decompression_eltype=Float64, + symmetric_pattern=sp, + ) +end + +function _color_sym_col_direct(A, order::Cint, pp::Bool, sp::Bool) + @order_barrier order _color_sym_col_direct_impl A pp sp +end + +function _fast_sym_col_direct_impl(A, order, pp::Bool, sp::Bool) + algo = @greedy :direct order pp + return fast_coloring( + A, ColoringProblem{:symmetric,:column}(), algo; symmetric_pattern=sp + ) +end + +function _fast_sym_col_direct(A, order::Cint, pp::Bool, sp::Bool) + @order_barrier order _fast_sym_col_direct_impl A pp sp +end + +## symmetric / column / substitution — `decompression_eltype` is part of the +## result type, so the element type travels as a type parameter. + +function _color_sym_col_subst_impl(A, order, pp::Bool, sp::Bool, ::Type{R}) where {R} + algo = @greedy :substitution order pp + # `R` survives into the inferred result type only because `coloring` is marked + # `Base.@constprop :aggressive` upstream (see src/interface.jl); otherwise the + # keyword tuple widens `Type{R}` to `DataType`, `R` is erased and `--trim=safe` + # rejects the call. A typeassert on the result does not rescue it: it narrows + # downstream of the call, while the verifier rejects the call itself. + return coloring( + A, + ColoringProblem{:symmetric,:column}(), + algo; + decompression_eltype=R, + symmetric_pattern=sp, + ) +end + +function _color_sym_col_subst(A, order::Cint, pp::Bool, sp::Bool, ::Type{R}) where {R} + @order_barrier order _color_sym_col_subst_impl A pp sp R +end + +function _fast_sym_col_subst_impl(A, order, pp::Bool, sp::Bool) + algo = @greedy :substitution order pp + return fast_coloring( + A, ColoringProblem{:symmetric,:column}(), algo; symmetric_pattern=sp + ) +end + +function _fast_sym_col_subst(A, order::Cint, pp::Bool, sp::Bool) + @order_barrier order _fast_sym_col_subst_impl A pp sp +end + +## nonsymmetric / bidirectional / direct + +function _color_ns_bid_direct_impl(A, order, pp::Bool, sp::Bool, ::Type{R}) where {R} + algo = @greedy :direct order pp + # `@constprop :aggressive` on `coloring` — see `_color_sym_col_subst_impl`. + return coloring( + A, + ColoringProblem{:nonsymmetric,:bidirectional}(), + algo; + decompression_eltype=R, + symmetric_pattern=sp, + ) +end + +function _color_ns_bid_direct(A, order::Cint, pp::Bool, sp::Bool, ::Type{R}) where {R} + @order_barrier order _color_ns_bid_direct_impl A pp sp R +end + +function _fast_ns_bid_direct_impl(A, order, pp::Bool, sp::Bool) + algo = @greedy :direct order pp + return fast_coloring( + A, ColoringProblem{:nonsymmetric,:bidirectional}(), algo; symmetric_pattern=sp + ) +end + +function _fast_ns_bid_direct(A, order::Cint, pp::Bool, sp::Bool) + @order_barrier order _fast_ns_bid_direct_impl A pp sp +end + +## nonsymmetric / bidirectional / substitution + +function _color_ns_bid_subst_impl(A, order, pp::Bool, sp::Bool, ::Type{R}) where {R} + algo = @greedy :substitution order pp + # `@constprop :aggressive` on `coloring` — see `_color_sym_col_subst_impl`. + return coloring( + A, + ColoringProblem{:nonsymmetric,:bidirectional}(), + algo; + decompression_eltype=R, + symmetric_pattern=sp, + ) +end + +function _color_ns_bid_subst(A, order::Cint, pp::Bool, sp::Bool, ::Type{R}) where {R} + @order_barrier order _color_ns_bid_subst_impl A pp sp R +end + +function _fast_ns_bid_subst_impl(A, order, pp::Bool, sp::Bool) + algo = @greedy :substitution order pp + return fast_coloring( + A, ColoringProblem{:nonsymmetric,:bidirectional}(), algo; symmetric_pattern=sp + ) +end + +function _fast_ns_bid_subst(A, order::Cint, pp::Bool, sp::Bool) + @order_barrier order _fast_ns_bid_subst_impl A pp sp +end + +function _do_coloring( + m::Cint, + n::Cint, + colptr::Ptr{Cint}, + rowval::Ptr{Cint}, + opts_ptr::Ptr{Cvoid}, + result_out::Ptr{Ptr{Cvoid}}, +) + result_out == C_NULL && return Cint(-3) + (colptr == C_NULL || rowval == C_NULL) && return Cint(-3) + (m > 0 && n > 0) || return Cint(-3) + opts = _load_options(opts_ptr) + _valid_options(opts) || return Cint(-3) + key = combo_key(opts.structure, opts.partition, opts.decompression, opts.dtype) + _supported_key(key) || return Cint(-2) + + base = Int(opts.index_base) + rc = _check_pattern(Int(m), Int(n), colptr, rowval, base) + rc == Cint(0) || return rc + A = _build_matrix(Int(m), Int(n), colptr, rowval, base) + + order = opts.order + pp = opts.postprocessing != Cint(0) + sp = opts.symmetric_pattern != Cint(0) + ib = opts.index_base + + # The `::` assertions are a safety net, not what makes this trim: they turn + # any future drift of the store table into a loud TypeError + # instead of a silent -1. A green `test_libsmc.jl` does not imply a green + # build -- the suite runs uncompiled and cannot see trim verifier errors, so + # run the juliac build before trusting a change to these paths. + if key == KEY_NS_COL_DIRECT_F64 || key == KEY_NS_COL_DIRECT_F32 + res = _color_ns_col(A, order, pp, sp)::SmcColumnResult + return _register!(store_ns_col_direct, res, key, ib, result_out) + elseif key == KEY_NS_ROW_DIRECT_F64 || key == KEY_NS_ROW_DIRECT_F32 + res = _color_ns_row(A, order, pp, sp)::SmcRowResult + return _register!(store_ns_row_direct, res, key, ib, result_out) + elseif key == KEY_SYM_COL_DIRECT_F64 || key == KEY_SYM_COL_DIRECT_F32 + res = _color_sym_col_direct(A, order, pp, sp)::SmcStarResult + return _register!(store_sym_col_direct, res, key, ib, result_out) + elseif key == KEY_SYM_COL_SUBST_F64 + res = _color_sym_col_subst(A, order, pp, sp, Float64)::SmcTreeResult{Float64} + return _register!(store_sym_col_subst_f64, res, key, ib, result_out) + elseif key == KEY_SYM_COL_SUBST_F32 + res = _color_sym_col_subst(A, order, pp, sp, Float32)::SmcTreeResult{Float32} + return _register!(store_sym_col_subst_f32, res, key, ib, result_out) + elseif key == KEY_NS_BID_DIRECT_F64 + res = _color_ns_bid_direct(A, order, pp, sp, Float64)::SmcBiDirectResult{Float64} + return _register!(store_ns_bid_direct_f64, res, key, ib, result_out) + elseif key == KEY_NS_BID_DIRECT_F32 + res = _color_ns_bid_direct(A, order, pp, sp, Float32)::SmcBiDirectResult{Float32} + return _register!(store_ns_bid_direct_f32, res, key, ib, result_out) + elseif key == KEY_NS_BID_SUBST_F64 + res = _color_ns_bid_subst(A, order, pp, sp, Float64)::SmcBiSubstResult{Float64} + return _register!(store_ns_bid_subst_f64, res, key, ib, result_out) + elseif key == KEY_NS_BID_SUBST_F32 + res = _color_ns_bid_subst(A, order, pp, sp, Float32)::SmcBiSubstResult{Float32} + return _register!(store_ns_bid_subst_f32, res, key, ib, result_out) + else + return Cint(-2) + end +end + +# Write one color vector and the color count. Color labels are never shifted +# by the index base: 0 is the neutral color, 1..ncolors are real colors. +function _emit_colors!(color, out::Ptr{Cint}, expected::Int, ncolors_out::Ptr{Cint}) + length(color) == expected || return Cint(-1) + maxcolor = 0 + @inbounds for i in 1:expected + ci = Int(color[i]) + unsafe_store!(out, Cint(ci), i) + ci > maxcolor && (maxcolor = ci) + end + unsafe_store!(ncolors_out, Cint(maxcolor)) + return Cint(0) +end + +# Bidirectional: both vectors, and `ncolors` is the sum of the two counts. +function _emit_colors2!( + row_color, + column_color, + row_out::Ptr{Cint}, + column_out::Ptr{Cint}, + m::Int, + n::Int, + ncolors_out::Ptr{Cint}, +) + (length(row_color) == m && length(column_color) == n) || return Cint(-1) + max_row = 0 + @inbounds for i in 1:m + ci = Int(row_color[i]) + unsafe_store!(row_out, Cint(ci), i) + ci > max_row && (max_row = ci) + end + max_column = 0 + @inbounds for j in 1:n + cj = Int(column_color[j]) + unsafe_store!(column_out, Cint(cj), j) + cj > max_column && (max_column = cj) + end + unsafe_store!(ncolors_out, Cint(max_row + max_column)) + return Cint(0) +end + +function _do_fast_coloring( + m::Cint, + n::Cint, + colptr::Ptr{Cint}, + rowval::Ptr{Cint}, + opts_ptr::Ptr{Cvoid}, + row_colors::Ptr{Cint}, + column_colors::Ptr{Cint}, + ncolors_out::Ptr{Cint}, +) + (colptr == C_NULL || rowval == C_NULL || ncolors_out == C_NULL) && return Cint(-3) + (m > 0 && n > 0) || return Cint(-3) + opts = _load_options(opts_ptr) + _valid_options(opts) || return Cint(-3) + key = combo_key(opts.structure, opts.partition, opts.decompression, opts.dtype) + _supported_key(key) || return Cint(-2) + + # A buffer may be NULL exactly when the partition produces no coloring for + # that dimension. + if opts.partition == SMC_COLUMN + column_colors == C_NULL && return Cint(-3) + elseif opts.partition == SMC_ROW + row_colors == C_NULL && return Cint(-3) + else + (row_colors == C_NULL || column_colors == C_NULL) && return Cint(-3) + end + + base = Int(opts.index_base) + rc = _check_pattern(Int(m), Int(n), colptr, rowval, base) + rc == Cint(0) || return rc + A = _build_matrix(Int(m), Int(n), colptr, rowval, base) + + order = opts.order + pp = opts.postprocessing != Cint(0) + sp = opts.symmetric_pattern != Cint(0) + + if key == KEY_NS_COL_DIRECT_F64 || key == KEY_NS_COL_DIRECT_F32 + color = _fast_ns_col(A, order, pp, sp)::Vector{Int64} + return _emit_colors!(color, column_colors, Int(n), ncolors_out) + elseif key == KEY_NS_ROW_DIRECT_F64 || key == KEY_NS_ROW_DIRECT_F32 + color = _fast_ns_row(A, order, pp, sp)::Vector{Int64} + return _emit_colors!(color, row_colors, Int(m), ncolors_out) + elseif key == KEY_SYM_COL_DIRECT_F64 || key == KEY_SYM_COL_DIRECT_F32 + color = _fast_sym_col_direct(A, order, pp, sp)::Vector{Int64} + return _emit_colors!(color, column_colors, Int(n), ncolors_out) + elseif key == KEY_SYM_COL_SUBST_F64 || key == KEY_SYM_COL_SUBST_F32 + color = _fast_sym_col_subst(A, order, pp, sp)::Vector{Int64} + return _emit_colors!(color, column_colors, Int(n), ncolors_out) + elseif key == KEY_NS_BID_DIRECT_F64 || key == KEY_NS_BID_DIRECT_F32 + colors = _fast_ns_bid_direct(A, order, pp, sp)::Tuple{Vector{Int64},Vector{Int64}} + return _emit_colors2!( + colors[1], colors[2], row_colors, column_colors, Int(m), Int(n), ncolors_out + ) + elseif key == KEY_NS_BID_SUBST_F64 || key == KEY_NS_BID_SUBST_F32 + colors = _fast_ns_bid_subst(A, order, pp, sp)::Tuple{Vector{Int64},Vector{Int64}} + return _emit_colors2!( + colors[1], colors[2], row_colors, column_colors, Int(m), Int(n), ncolors_out + ) + else + return Cint(-2) + end +end + +# =========================================================================== +# C entry points. Each wraps its `_do_*` helper in try/catch and returns: +# 0 success +# -1 internal error (a Julia exception was caught and logged) +# -2 unsupported (structure, partition, decompression, dtype) combination +# -3 invalid argument (NULL, bad dimension, short buffer, bad enum or base) +# -4 invalid or already-freed handle +# =========================================================================== + +# Always initialise an options struct with this before overriding fields. +@export_sig smc_default_options "SmcColoringOptions" + +Base.@ccallable function smc_default_options()::SmcColoringOptionsC + return SMC_DEFAULT_OPTIONS +end + +@export_sig smc_version "void" (major, "int*") (minor, "int*") (patch, "int*") + +Base.@ccallable function smc_version( + major::Ptr{Cint}, minor::Ptr{Cint}, patch::Ptr{Cint} +)::Cvoid + major == C_NULL || unsafe_store!(major, Cint(_SMC_VERSION.major)) + minor == C_NULL || unsafe_store!(minor, Cint(_SMC_VERSION.minor)) + patch == C_NULL || unsafe_store!(patch, Cint(_SMC_VERSION.patch)) + return nothing +end + +# smc_coloring — color the m-by-n CSC pattern (`colptr` / `rowval` in +# opts->index_base, NULL opts meaning the defaults) and write an opaque handle +# to `result_out`, to be released with smc_result_free. Only the structure is +# needed; the values are passed later to smc_compress. The caller's arrays are +# copied and never modified. +@export_sig smc_coloring "int" (m, "int") (n, "int") (colptr, "const int*") ( + rowval, "const int*" +) (opts, "const SmcColoringOptions*") (result_out, "void**") + +Base.@ccallable function smc_coloring( + m::Cint, + n::Cint, + colptr::Ptr{Cint}, + rowval::Ptr{Cint}, + opts::Ptr{Cvoid}, + result_out::Ptr{Ptr{Cvoid}}, +)::Cint + try + return _do_coloring(m, n, colptr, rowval, opts, result_out) + catch e + @error "smc_coloring" exception = e + return Cint(-1) + end +end + +# smc_fast_coloring — write the colors directly, without allocating a handle. +# A buffer may be NULL exactly when the partition produces no coloring for that +# dimension; SMC_BIDIRECTIONAL fills both. +@export_sig smc_fast_coloring "int" (m, "int") (n, "int") (colptr, "const int*") ( + rowval, "const int*" +) (opts, "const SmcColoringOptions*") (row_colors, "int*") (column_colors, "int*") ( + ncolors_out, "int*" +) + +Base.@ccallable function smc_fast_coloring( + m::Cint, + n::Cint, + colptr::Ptr{Cint}, + rowval::Ptr{Cint}, + opts::Ptr{Cvoid}, + row_colors::Ptr{Cint}, + column_colors::Ptr{Cint}, + ncolors_out::Ptr{Cint}, +)::Cint + try + return _do_fast_coloring( + m, n, colptr, rowval, opts, row_colors, column_colors, ncolors_out + ) + catch e + @error "smc_fast_coloring" exception = e + return Cint(-1) + end +end + +# Freeing a handle twice returns -4, not a crash. +@export_sig smc_result_free "int" (result, "void*") + +Base.@ccallable function smc_result_free(result::Ptr{Cvoid})::Cint + try + return _do_free!(result) + catch e + @error "smc_result_free" exception = e + return Cint(-1) + end +end + +@export_sig smc_ncolors "int" (result, "void*") (ncolors_out, "int*") + +Base.@ccallable function smc_ncolors(result::Ptr{Cvoid}, ncolors_out::Ptr{Cint})::Cint + try + return _do_ncolors(result, ncolors_out) + catch e + @error "smc_ncolors" exception = e + return Cint(-1) + end +end + +# `len` must be at least n; -2 when the partition has no column coloring. +@export_sig smc_column_colors "int" (result, "void*") (colors, "int*") (len, "int") + +Base.@ccallable function smc_column_colors( + result::Ptr{Cvoid}, colors::Ptr{Cint}, len::Cint +)::Cint + try + return _do_column_colors!(result, colors, len) + catch e + @error "smc_column_colors" exception = e + return Cint(-1) + end +end + +# `len` must be at least m; -2 when the partition has no row coloring. +@export_sig smc_row_colors "int" (result, "void*") (colors, "int*") (len, "int") + +Base.@ccallable function smc_row_colors( + result::Ptr{Cvoid}, colors::Ptr{Cint}, len::Cint +)::Cint + try + return _do_row_colors!(result, colors, len) + catch e + @error "smc_row_colors" exception = e + return Cint(-1) + end +end + +# smc_ncolumn_groups / smc_nrow_groups — number of color classes. +@export_sig smc_ncolumn_groups "int" (result, "void*") (ngroups_out, "int*") + +Base.@ccallable function smc_ncolumn_groups( + result::Ptr{Cvoid}, ngroups_out::Ptr{Cint} +)::Cint + try + return _do_ncolumn_groups(result, ngroups_out) + catch e + @error "smc_ncolumn_groups" exception = e + return Cint(-1) + end +end + +@export_sig smc_nrow_groups "int" (result, "void*") (ngroups_out, "int*") + +Base.@ccallable function smc_nrow_groups(result::Ptr{Cvoid}, ngroups_out::Ptr{Cint})::Cint + try + return _do_nrow_groups(result, ngroups_out) + catch e + @error "smc_nrow_groups" exception = e + return Cint(-1) + end +end + +# Group members. `group` is 1-based over 1..ngroups whatever the index base; +# the member indices themselves are written in the caller's index base. +# Query the size first, then fetch. +@export_sig smc_column_group_size "int" (result, "void*") (group, "int") (size_out, "int*") + +Base.@ccallable function smc_column_group_size( + result::Ptr{Cvoid}, group::Cint, size_out::Ptr{Cint} +)::Cint + try + return _do_column_group_size(result, group, size_out) + catch e + @error "smc_column_group_size" exception = e + return Cint(-1) + end +end + +@export_sig smc_column_group "int" (result, "void*") (group, "int") (members, "int*") ( + len, "int" +) + +Base.@ccallable function smc_column_group( + result::Ptr{Cvoid}, group::Cint, members::Ptr{Cint}, len::Cint +)::Cint + try + return _do_column_group!(result, group, members, len) + catch e + @error "smc_column_group" exception = e + return Cint(-1) + end +end + +@export_sig smc_row_group_size "int" (result, "void*") (group, "int") (size_out, "int*") + +Base.@ccallable function smc_row_group_size( + result::Ptr{Cvoid}, group::Cint, size_out::Ptr{Cint} +)::Cint + try + return _do_row_group_size(result, group, size_out) + catch e + @error "smc_row_group_size" exception = e + return Cint(-1) + end +end + +@export_sig smc_row_group "int" (result, "void*") (group, "int") (members, "int*") ( + len, "int" +) + +Base.@ccallable function smc_row_group( + result::Ptr{Cvoid}, group::Cint, members::Ptr{Cint}, len::Cint +)::Cint + try + return _do_row_group!(result, group, members, len) + catch e + @error "smc_row_group" exception = e + return Cint(-1) + end +end + +# Stored entries of the colored pattern: exactly the length `nzval` must have +# in smc_compress. +@export_sig smc_nnz "int" (result, "void*") (nnz_out, "int*") + +Base.@ccallable function smc_nnz(result::Ptr{Cvoid}, nnz_out::Ptr{Cint})::Cint + try + return _do_nnz(result, nnz_out) + catch e + @error "smc_nnz" exception = e + return Cint(-1) + end +end + +# Dimensions of the colored matrix; `A_out` of smc_decompress holds m*n elements. +@export_sig smc_size "int" (result, "void*") (m_out, "int*") (n_out, "int*") + +Base.@ccallable function smc_size( + result::Ptr{Cvoid}, m_out::Ptr{Cint}, n_out::Ptr{Cint} +)::Cint + try + return _do_size(result, m_out, n_out) + catch e + @error "smc_size" exception = e + return Cint(-1) + end +end + +# Only a bidirectional partition has a row-compressed matrix; otherwise +# *Br_rows and *Br_cols are set to 0. +@export_sig smc_compressed_size "int" (result, "void*") (Br_rows, "int*") (Br_cols, "int*") ( + Bc_rows, "int*" +) (Bc_cols, "int*") + +Base.@ccallable function smc_compressed_size( + result::Ptr{Cvoid}, + Br_rows::Ptr{Cint}, + Br_cols::Ptr{Cint}, + Bc_rows::Ptr{Cint}, + Bc_cols::Ptr{Cint}, +)::Cint + try + return _do_compressed_size(result, Br_rows, Br_cols, Bc_rows, Bc_cols) + catch e + @error "smc_compressed_size" exception = e + return Cint(-1) + end +end + +# smc_compress — compress into the dense buffers Br (row-compressed, unused and +# possibly NULL with Br_len 0 unless the partition is bidirectional) and Bc +# (column-compressed). `nzval` holds the CSC values in the same order as the +# rowval given to smc_coloring, as double* or float* according to opts->dtype. +# +# Every `*_len` is an element count, not a byte count: nzval_len >= smc_nnz, +# Br_len >= Br_rows * Br_cols, Bc_len >= Bc_rows * Bc_cols. Both buffers are +# column-major with the dimensions of smc_compressed_size and are written in +# full, so the caller need not zero them. A buffer that is too small is -3, +# decided before a single element is read or written. +@export_sig smc_compress "int" (result, "void*") (nzval, "const void*") ( + nzval_len, "size_t" +) (Br, "void*") (Br_len, "size_t") (Bc, "void*") (Bc_len, "size_t") + +Base.@ccallable function smc_compress( + result::Ptr{Cvoid}, + nzval::Ptr{Cvoid}, + nzval_len::Csize_t, + Br::Ptr{Cvoid}, + Br_len::Csize_t, + Bc::Ptr{Cvoid}, + Bc_len::Csize_t, +)::Cint + try + return _do_compress!(result, nzval, nzval_len, Br, Br_len, Bc, Bc_len) + catch e + @error "smc_compress" exception = e + return Cint(-1) + end +end + +# smc_decompress — recover the full m-by-n dense matrix (column-major); entries +# outside the sparsity pattern are set to zero. Br / Bc follow the rules of +# smc_compress. A_len is an element count, at least m * n from smc_size; it is +# a size_t because m * n overflows an int for perfectly ordinary dimensions. +@export_sig smc_decompress "int" (result, "void*") (Br, "const void*") (Br_len, "size_t") ( + Bc, "const void*" +) (Bc_len, "size_t") (A_out, "void*") (A_len, "size_t") + +Base.@ccallable function smc_decompress( + result::Ptr{Cvoid}, + Br::Ptr{Cvoid}, + Br_len::Csize_t, + Bc::Ptr{Cvoid}, + Bc_len::Csize_t, + A_out::Ptr{Cvoid}, + A_len::Csize_t, +)::Cint + try + return _do_decompress!(result, Br, Br_len, Bc, Bc_len, A_out, A_len) + catch e + @error "smc_decompress" exception = e + return Cint(-1) + end +end + +end # module LibSMC diff --git a/interfaces/src/c_enums.jl b/interfaces/src/c_enums.jl new file mode 100644 index 00000000..66270081 --- /dev/null +++ b/interfaces/src/c_enums.jl @@ -0,0 +1,46 @@ +# c_enums.jl — Julia mirror of the C types declared in include/smc.h. +# +# The enumerator values (SmcDataType, SmcStructure, SmcPartition, +# SmcDecompression, SmcOrder) live in scripts/coloring_table.jl, the single +# source of truth shared with the header generator, and are already in scope. + +# Mirror of the SmcColoringOptions C struct, in the field order of smc.h +# section 2 and of include/smc.h. All fields are `Cint`, so the C and Julia +# layouts agree with no padding and the struct is `isbits`: it can be +# `unsafe_load`ed from the caller's pointer and returned by value. +# Changing the field order is an ABI break. +struct SmcColoringOptionsC + structure::Cint # SmcStructure + partition::Cint # SmcPartition + decompression::Cint # SmcDecompression + order::Cint # SmcOrder + postprocessing::Cint # 0/1 — neutral color 0 where possible + symmetric_pattern::Cint # 0/1 — assert the sparsity pattern is symmetric + index_base::Cint # 0 or 1 — index base of colptr / rowval / groups + dtype::Cint # SmcDataType — element type of compress/decompress +end + +# Also returned whenever a NULL options pointer is passed. +const SMC_DEFAULT_OPTIONS = SmcColoringOptionsC( + SMC_NONSYMMETRIC, # structure + SMC_COLUMN, # partition + SMC_DIRECT, # decompression + SMC_NATURAL, # order + Cint(0), # postprocessing + Cint(0), # symmetric_pattern + Cint(0), # index_base (0 = C-natural) + SMC_FLOAT64, # dtype +) + +# Out of range is an invalid argument (-3), a different failure from a +# well-formed but unsupported combination (-2). `postprocessing` and +# `symmetric_pattern` are read as booleans, so any nonzero value is accepted. +function _valid_options(o::SmcColoringOptionsC) + Cint(0) <= o.structure <= SMC_MAX_STRUCTURE || return false + Cint(0) <= o.partition <= SMC_MAX_PARTITION || return false + Cint(0) <= o.decompression <= SMC_MAX_DECOMPRESSION || return false + Cint(0) <= o.order <= SMC_MAX_ORDER || return false + Cint(0) <= o.dtype <= SMC_MAX_DTYPE || return false + o.index_base == Cint(0) || o.index_base == Cint(1) || return false + return true +end diff --git a/interfaces/src/c_stores.jl b/interfaces/src/c_stores.jl new file mode 100644 index 00000000..cb2165bf --- /dev/null +++ b/interfaces/src/c_stores.jl @@ -0,0 +1,792 @@ +# c_stores.jl — typed handle stores and every operation that dispatches on a +# handle (queries, compression, decompression). +# +# `smc_coloring` roots each result in one of the nine typed stores of +# section 3 and hands back an opaque handle; a parallel key store records the +# combo key, so a later call can recover the *concrete* type of the result, +# which is what `--trim=safe` requires. Nine stores and not twelve because +# `decompression_eltype` is absent from the Column / Row / StarSet result types. + +# The internal matrix is always Float64 / Int64: a coloring only looks at the +# structure, and `dtype` is a property of the compressed buffers, not the pattern. +const SmcMatrix = SparseMatrixCSC{Float64,Int64} + +# The element type of every `group` field: a view into one contiguous block of +# a single flat index vector (see `SparseMatrixColorings.group_by_color`). +const SmcGroupView = SubArray{Int64,1,Vector{Int64},Tuple{UnitRange{Int64}},true} +const SmcGroups = Vector{SmcGroupView} + +const SmcColumnResult = SparseMatrixColorings.ColumnColoringResult{ + SmcMatrix, + Int64, + SparseMatrixColorings.BipartiteGraph{Int64}, + Vector{Int64}, + SmcGroups, + Vector{Int64}, + Nothing, +} + +const SmcRowResult = SparseMatrixColorings.RowColoringResult{ + SmcMatrix, + Int64, + SparseMatrixColorings.BipartiteGraph{Int64}, + Vector{Int64}, + SmcGroups, + Vector{Int64}, + Nothing, +} + +const SmcStarResult = SparseMatrixColorings.StarSetColoringResult{ + SmcMatrix, + Int64, + SparseMatrixColorings.AdjacencyGraph{Int64,false}, + Vector{Int64}, + SmcGroups, + Vector{Int64}, + Nothing, +} + +const SmcTreeResult{R} = SparseMatrixColorings.TreeSetColoringResult{ + SmcMatrix,Int64,SparseMatrixColorings.AdjacencyGraph{Int64,false},SmcGroups,R +} + +# A bicoloring colors the augmented matrix [0 Aᵀ; A 0], whose pattern is a +# `SparsityPatternCSC` rather than a `SparseMatrixCSC`, so its inner symmetric +# result is a *different* concrete type from the ones above. +const SmcAugStarResult = SparseMatrixColorings.StarSetColoringResult{ + SparseMatrixColorings.SparsityPatternCSC{Int64}, + Int64, + SparseMatrixColorings.AdjacencyGraph{Int64,true}, + Vector{Int64}, + SmcGroups, + Vector{Int64}, + Nothing, +} + +const SmcAugTreeResult{R} = SparseMatrixColorings.TreeSetColoringResult{ + SparseMatrixColorings.SparsityPatternCSC{Int64}, + Int64, + SparseMatrixColorings.AdjacencyGraph{Int64,true}, + SmcGroups, + R, +} + +const SmcBiDirectResult{R} = SparseMatrixColorings.BicoloringResult{ + SmcMatrix, + Int64, + SparseMatrixColorings.AdjacencyGraph{Int64,true}, + :direct, + SmcGroups, + SmcAugStarResult, + R, +} + +const SmcBiSubstResult{R} = SparseMatrixColorings.BicoloringResult{ + SmcMatrix, + Int64, + SparseMatrixColorings.AdjacencyGraph{Int64,true}, + :substitution, + SmcGroups, + SmcAugTreeResult{R}, + R, +} + +# Shorthand used to dispatch the typed helpers on the *partition* of a result. +const SmcResult{structure,partition,decompression} = SparseMatrixColorings.AbstractColoringResult{ + structure,partition,decompression +} + +# Every store value type is concrete, so `--trim=safe` can resolve every call +# made on a value fetched out of a store. + +const store_ns_col_direct = Dict{Ptr{Cvoid},SmcColumnResult}() +const store_ns_row_direct = Dict{Ptr{Cvoid},SmcRowResult}() +const store_sym_col_direct = Dict{Ptr{Cvoid},SmcStarResult}() +const store_sym_col_subst_f64 = Dict{Ptr{Cvoid},SmcTreeResult{Float64}}() +const store_sym_col_subst_f32 = Dict{Ptr{Cvoid},SmcTreeResult{Float32}}() +const store_ns_bid_direct_f64 = Dict{Ptr{Cvoid},SmcBiDirectResult{Float64}}() +const store_ns_bid_direct_f32 = Dict{Ptr{Cvoid},SmcBiDirectResult{Float32}}() +const store_ns_bid_subst_f64 = Dict{Ptr{Cvoid},SmcBiSubstResult{Float64}}() +const store_ns_bid_subst_f32 = Dict{Ptr{Cvoid},SmcBiSubstResult{Float32}}() + +# handle -> combo key: also the membership test. A handle that is absent is +# invalid or already freed, which is -4 rather than a crash. +const result_key_store = Dict{Ptr{Cvoid},UInt8}() + +# handle -> index base of the caller, remembered from `smc_coloring` because the +# group queries report member indices in that base and take no options. +const result_base_store = Dict{Ptr{Cvoid},Cint}() + +# The handle is a monotone counter, not the `pointer_from_objref(result)` of +# Every `AbstractColoringResult` is an immutable struct and +# `pointer_from_objref` refuses those. A counter is also safer, since a value is +# never recycled, which is what makes use-after-free and double-free return -4 +# reliably. It is only a token, never dereferenced, and starts at 1 so that a +# valid handle is never NULL. + +const _handle_counter = Ref{UInt}(0) + +function _new_handle() + _handle_counter[] += UInt(1) + return Ptr{Cvoid}(_handle_counter[]) +end + +function _result_key(handle::Ptr{Cvoid}) + haskey(result_key_store, handle) || return KEY_INVALID + return result_key_store[handle] +end + +function _result_base(handle::Ptr{Cvoid}) + haskey(result_base_store, handle) || return Cint(0) + return result_base_store[handle] +end + +# `T` is concrete at every call site, so nothing here is dynamically dispatched. +function _register!( + store::Dict{Ptr{Cvoid},T}, res::T, key::UInt8, base::Cint, result_out::Ptr{Ptr{Cvoid}} +) where {T} + handle = _new_handle() + store[handle] = res + result_key_store[handle] = key + result_base_store[handle] = base + unsafe_store!(result_out, handle) + return Cint(0) +end + +function _unregister!(store::Dict{Ptr{Cvoid},T}, handle::Ptr{Cvoid}) where {T} + delete!(store, handle) + return Cint(0) +end + +# Key -> store routing: twelve combo keys served by nine stores. The dispatch +# macros below expand to an if/elseif chain over the keys, so every branch +# indexes a store whose value type is statically known. A key that matches +# nothing is an unknown handle: -4. + +const _KEY_TO_STORE = ( + (:KEY_NS_COL_DIRECT_F64, :store_ns_col_direct), + (:KEY_NS_COL_DIRECT_F32, :store_ns_col_direct), + (:KEY_NS_ROW_DIRECT_F64, :store_ns_row_direct), + (:KEY_NS_ROW_DIRECT_F32, :store_ns_row_direct), + (:KEY_SYM_COL_DIRECT_F64, :store_sym_col_direct), + (:KEY_SYM_COL_DIRECT_F32, :store_sym_col_direct), + (:KEY_SYM_COL_SUBST_F64, :store_sym_col_subst_f64), + (:KEY_SYM_COL_SUBST_F32, :store_sym_col_subst_f32), + (:KEY_NS_BID_DIRECT_F64, :store_ns_bid_direct_f64), + (:KEY_NS_BID_DIRECT_F32, :store_ns_bid_direct_f32), + (:KEY_NS_BID_SUBST_F64, :store_ns_bid_subst_f64), + (:KEY_NS_BID_SUBST_F32, :store_ns_bid_subst_f32), +) + +function _dispatch_chain(key, handle, f, args, with_store::Bool) + chain = :(Cint(-4)) + for i in length(_KEY_TO_STORE):-1:1 + keyname, storename = _KEY_TO_STORE[i] + subject = with_store ? storename : Expr(:ref, storename, handle) + call = Expr(:call, f, subject, args...) + chain = Expr(:if, :($key == $keyname), call, chain) + end + return chain +end + +""" + @key_dispatch key handle f args... + +Expand to `f(store[handle], args...)` for the store that `key` selects. +""" +macro key_dispatch(key, handle, f, args...) + return esc(_dispatch_chain(key, handle, f, args, false)) +end + +""" + @store_dispatch key handle f args... + +Expand to `f(store, args...)` for the store that `key` selects. +""" +macro store_dispatch(key, handle, f, args...) + return esc(_dispatch_chain(key, handle, f, args, true)) +end + +# Small pointer helpers. Everything is written through `unsafe_store!` on the +# caller's buffer; the caller owns that memory, so nothing needs `GC.@preserve`. + +function _store_int(out::Ptr{Cint}, value::Int) + out == C_NULL && return Cint(-3) + unsafe_store!(out, Cint(value)) + return Cint(0) +end + +# Copy a color vector (labels in 0..ncolors, never shifted by the index base). +function _copy_colors!(color, out::Ptr{Cint}, len::Cint) + out == C_NULL && return Cint(-3) + n = length(color) + Int(len) < n && return Cint(-3) + @inbounds for i in 1:n + unsafe_store!(out, Cint(color[i]), i) + end + return Cint(0) +end + +function _group_size(groups, group::Cint, out::Ptr{Cint}) + out == C_NULL && return Cint(-3) + g = Int(group) + (g < 1 || g > length(groups)) && return Cint(-3) + unsafe_store!(out, Cint(length(groups[g]))) + return Cint(0) +end + +# Group members, written in the caller's index base. +function _copy_group!(groups, group::Cint, out::Ptr{Cint}, len::Cint, base::Cint) + out == C_NULL && return Cint(-3) + g = Int(group) + (g < 1 || g > length(groups)) && return Cint(-3) + members = groups[g] + nm = length(members) + Int(len) < nm && return Cint(-3) + shift = Int(base) - 1 + @inbounds for i in 1:nm + unsafe_store!(out, Cint(Int(members[i]) + shift), i) + end + return Cint(0) +end + +function _zero_fill!(p::Ptr{R}, len::Int) where {R} + @inbounds for i in 1:len + unsafe_store!(p, zero(R), i) + end + return nothing +end + +# A column-major view of a caller buffer. A zero-sized compressed matrix may +# come in as NULL, in which case an empty Julia matrix stands in. +function _wrap_matrix(::Type{R}, p::Ptr{Cvoid}, nrows::Int, ncols::Int) where {R} + (p == C_NULL || nrows * ncols == 0) && return Matrix{R}(undef, nrows, ncols) + return unsafe_wrap(Matrix{R}, Ptr{R}(p), (nrows, ncols)) +end + +# Hand-rolled compression, for two independent reasons: these loops write +# straight into the caller's buffer, whereas `SparseMatrixColorings.compress` +# allocates a `Matrix` we would copy and throw away; and `compress` would not +# trim, since its `sum` over a sparse matrix bottoms out in an unresolvable +# `Base.mapreduce_empty(::typeof(identity), ::Function, T)::Any`. +# +# The result is identical: B[:, c] is the sum of the columns of group c, +# B[c, :] the sum of its rows, and the neutral color 0 contributes to nothing. + +# B is nrows-by-* column-major; B[rowval[k], color[j]] += nzval[k] +function _accumulate_columns!( + B::Ptr{R}, nzval::Ptr{R}, A::SmcMatrix, color, nrows::Int +) where {R} + colptr = A.colptr + rowval = A.rowval + @inbounds for j in 1:size(A, 2) + cj = Int(color[j]) + cj == 0 && continue + offset = (cj - 1) * nrows + for k in colptr[j]:(colptr[j + 1] - 1) + idx = offset + Int(rowval[k]) + unsafe_store!(B, unsafe_load(B, idx) + unsafe_load(nzval, k), idx) + end + end + return nothing +end + +# B is nrows-by-* column-major; B[color[rowval[k]], j] += nzval[k] +function _accumulate_rows!( + B::Ptr{R}, nzval::Ptr{R}, A::SmcMatrix, color, nrows::Int +) where {R} + colptr = A.colptr + rowval = A.rowval + @inbounds for j in 1:size(A, 2) + offset = (j - 1) * nrows + for k in colptr[j]:(colptr[j + 1] - 1) + ci = Int(color[rowval[k]]) + ci == 0 && continue + idx = offset + ci + unsafe_store!(B, unsafe_load(B, idx) + unsafe_load(nzval, k), idx) + end + end + return nothing +end + +# Typed helpers. Each is called from a branch where the result has a statically +# known concrete type, so the partition dispatch below resolves at compile time. +# A query the partition cannot answer (row information of a column coloring, and +# vice versa) is -2, not -3: the argument is well formed, there is just no result. + +_typed_ncolors(res, out::Ptr{Cint}) = _store_int(out, SparseMatrixColorings.ncolors(res)) + +## Column colors and groups — absent from a :row partition. + +_typed_column_colors!(::SmcResult{s,:row,d}, ::Ptr{Cint}, ::Cint) where {s,d} = Cint(-2) + +function _typed_column_colors!( + res::SmcResult{s,:column,d}, out::Ptr{Cint}, len::Cint +) where {s,d} + return _copy_colors!(SparseMatrixColorings.column_colors(res), out, len) +end + +function _typed_column_colors!( + res::SmcResult{s,:bidirectional,d}, out::Ptr{Cint}, len::Cint +) where {s,d} + return _copy_colors!(SparseMatrixColorings.column_colors(res), out, len) +end + +_typed_ncolumn_groups(::SmcResult{s,:row,d}, ::Ptr{Cint}) where {s,d} = Cint(-2) + +function _typed_ncolumn_groups(res::SmcResult{s,:column,d}, out::Ptr{Cint}) where {s,d} + return _store_int(out, length(SparseMatrixColorings.column_groups(res))) +end + +function _typed_ncolumn_groups( + res::SmcResult{s,:bidirectional,d}, out::Ptr{Cint} +) where {s,d} + return _store_int(out, length(SparseMatrixColorings.column_groups(res))) +end + +_typed_column_group_size(::SmcResult{s,:row,d}, ::Cint, ::Ptr{Cint}) where {s,d} = Cint(-2) + +function _typed_column_group_size( + res::SmcResult{s,:column,d}, group::Cint, out::Ptr{Cint} +) where {s,d} + return _group_size(SparseMatrixColorings.column_groups(res), group, out) +end + +function _typed_column_group_size( + res::SmcResult{s,:bidirectional,d}, group::Cint, out::Ptr{Cint} +) where {s,d} + return _group_size(SparseMatrixColorings.column_groups(res), group, out) +end + +function _typed_column_group!( + ::SmcResult{s,:row,d}, ::Cint, ::Ptr{Cint}, ::Cint, ::Cint +) where {s,d} + return Cint(-2) +end + +function _typed_column_group!( + res::SmcResult{s,:column,d}, group::Cint, out::Ptr{Cint}, len::Cint, base::Cint +) where {s,d} + return _copy_group!(SparseMatrixColorings.column_groups(res), group, out, len, base) +end + +function _typed_column_group!( + res::SmcResult{s,:bidirectional,d}, group::Cint, out::Ptr{Cint}, len::Cint, base::Cint +) where {s,d} + return _copy_group!(SparseMatrixColorings.column_groups(res), group, out, len, base) +end + +## Row colors and groups — absent from a :column partition. + +_typed_row_colors!(::SmcResult{s,:column,d}, ::Ptr{Cint}, ::Cint) where {s,d} = Cint(-2) + +function _typed_row_colors!(res::SmcResult{s,:row,d}, out::Ptr{Cint}, len::Cint) where {s,d} + return _copy_colors!(SparseMatrixColorings.row_colors(res), out, len) +end + +function _typed_row_colors!( + res::SmcResult{s,:bidirectional,d}, out::Ptr{Cint}, len::Cint +) where {s,d} + return _copy_colors!(SparseMatrixColorings.row_colors(res), out, len) +end + +_typed_nrow_groups(::SmcResult{s,:column,d}, ::Ptr{Cint}) where {s,d} = Cint(-2) + +function _typed_nrow_groups(res::SmcResult{s,:row,d}, out::Ptr{Cint}) where {s,d} + return _store_int(out, length(SparseMatrixColorings.row_groups(res))) +end + +function _typed_nrow_groups(res::SmcResult{s,:bidirectional,d}, out::Ptr{Cint}) where {s,d} + return _store_int(out, length(SparseMatrixColorings.row_groups(res))) +end + +_typed_row_group_size(::SmcResult{s,:column,d}, ::Cint, ::Ptr{Cint}) where {s,d} = Cint(-2) + +function _typed_row_group_size( + res::SmcResult{s,:row,d}, group::Cint, out::Ptr{Cint} +) where {s,d} + return _group_size(SparseMatrixColorings.row_groups(res), group, out) +end + +function _typed_row_group_size( + res::SmcResult{s,:bidirectional,d}, group::Cint, out::Ptr{Cint} +) where {s,d} + return _group_size(SparseMatrixColorings.row_groups(res), group, out) +end + +function _typed_row_group!( + ::SmcResult{s,:column,d}, ::Cint, ::Ptr{Cint}, ::Cint, ::Cint +) where {s,d} + return Cint(-2) +end + +function _typed_row_group!( + res::SmcResult{s,:row,d}, group::Cint, out::Ptr{Cint}, len::Cint, base::Cint +) where {s,d} + return _copy_group!(SparseMatrixColorings.row_groups(res), group, out, len, base) +end + +function _typed_row_group!( + res::SmcResult{s,:bidirectional,d}, group::Cint, out::Ptr{Cint}, len::Cint, base::Cint +) where {s,d} + return _copy_group!(SparseMatrixColorings.row_groups(res), group, out, len, base) +end + +## Dimensions of the compressed matrices, as `(Br_rows, Br_cols, Bc_rows, Bc_cols)`. +## Only a bidirectional partition has a row-compressed matrix. + +function _compressed_dims(res::SmcResult{s,:column,d}) where {s,d} + return (0, 0, size(res.A, 1), length(SparseMatrixColorings.column_groups(res))) +end + +function _compressed_dims(res::SmcResult{s,:row,d}) where {s,d} + return (0, 0, length(SparseMatrixColorings.row_groups(res)), size(res.A, 2)) +end + +function _compressed_dims(res::SmcResult{s,:bidirectional,d}) where {s,d} + return ( + length(SparseMatrixColorings.row_groups(res)), + size(res.A, 2), + size(res.A, 1), + length(SparseMatrixColorings.column_groups(res)), + ) +end + +## Dispatches on the partition type parameter, so each caller of the buffer +## checks below sees a compile-time constant. + +_bidirectional(::SmcResult{s,:column,d}) where {s,d} = false +_bidirectional(::SmcResult{s,:row,d}) where {s,d} = false +_bidirectional(::SmcResult{s,:bidirectional,d}) where {s,d} = true + +## Sizing queries. `res.A` is the pattern that was colored, whatever the +## partition, so both answers are partition-independent. + +_typed_nnz(res, out::Ptr{Cint}) = _store_int(out, SparseArrays.nnz(res.A)) + +function _typed_size(res, m_out::Ptr{Cint}, n_out::Ptr{Cint}) + (m_out == C_NULL || n_out == C_NULL) && return Cint(-3) + unsafe_store!(m_out, Cint(size(res.A, 1))) + unsafe_store!(n_out, Cint(size(res.A, 2))) + return Cint(0) +end + +function _typed_compressed_size( + res, br_rows::Ptr{Cint}, br_cols::Ptr{Cint}, bc_rows::Ptr{Cint}, bc_cols::Ptr{Cint} +) + (br_rows == C_NULL || br_cols == C_NULL || bc_rows == C_NULL || bc_cols == C_NULL) && + return Cint(-3) + brr, brc, bcr, bcc = _compressed_dims(res) + unsafe_store!(br_rows, Cint(brr)) + unsafe_store!(br_cols, Cint(brc)) + unsafe_store!(bc_rows, Cint(bcr)) + unsafe_store!(bc_cols, Cint(bcc)) + return Cint(0) +end + +## Buffer validation. Lengths are ELEMENT counts of the type selected by +## `dtype`, checked here before a single element is read or written: the loops +## above and the `unsafe_wrap` of `_decompress_impl!` take the caller's word for +## the size of the buffer, so this is the only guard against a heap overrun. +## Comparisons are in unsigned `Csize_t`, so a length of 0 or of SIZE_MAX cannot +## wrap into a value that passes. + +# Br is unused unless the partition is bidirectional (it may then be NULL with +# Br_len 0); a bidirectional result requires both buffers. +function _check_compressed( + res, Br::Ptr{Cvoid}, Br_len::Csize_t, Bc::Ptr{Cvoid}, Bc_len::Csize_t +) + brr, brc, bcr, bcc = _compressed_dims(res) + if _bidirectional(res) + (Br == C_NULL || Bc == C_NULL) && return Cint(-3) + Br_len < Csize_t(brr * brc) && return Cint(-3) + else + (bcr * bcc > 0 && Bc == C_NULL) && return Cint(-3) + end + Bc_len < Csize_t(bcr * bcc) && return Cint(-3) + return Cint(0) +end + +## Compression. `dtype` is the low bit of the combo key; the two branches make +## the element type a compile-time constant (function barrier). + +function _typed_compress!( + res, + dtype::Cint, + nzval::Ptr{Cvoid}, + nzval_len::Csize_t, + Br::Ptr{Cvoid}, + Br_len::Csize_t, + Bc::Ptr{Cvoid}, + Bc_len::Csize_t, +) + nzval == C_NULL && return Cint(-3) + nzval_len < Csize_t(SparseArrays.nnz(res.A)) && return Cint(-3) + rc = _check_compressed(res, Br, Br_len, Bc, Bc_len) + rc == Cint(0) || return rc + brr, brc, bcr, bcc = _compressed_dims(res) + if dtype == SMC_FLOAT64 + return _compress_impl!(res, Float64, nzval, Br, Bc, brr, brc, bcr, bcc) + else + return _compress_impl!(res, Float32, nzval, Br, Bc, brr, brc, bcr, bcc) + end +end + +function _compress_impl!( + res::SmcResult{s,:column,d}, + ::Type{R}, + nzval::Ptr{Cvoid}, + Br::Ptr{Cvoid}, + Bc::Ptr{Cvoid}, + brr::Int, + brc::Int, + bcr::Int, + bcc::Int, +) where {s,d,R} + v = Ptr{R}(nzval) + B = Ptr{R}(Bc) + _zero_fill!(B, bcr * bcc) + _accumulate_columns!(B, v, res.A, SparseMatrixColorings.column_colors(res), bcr) + return Cint(0) +end + +function _compress_impl!( + res::SmcResult{s,:row,d}, + ::Type{R}, + nzval::Ptr{Cvoid}, + Br::Ptr{Cvoid}, + Bc::Ptr{Cvoid}, + brr::Int, + brc::Int, + bcr::Int, + bcc::Int, +) where {s,d,R} + v = Ptr{R}(nzval) + B = Ptr{R}(Bc) + _zero_fill!(B, bcr * bcc) + _accumulate_rows!(B, v, res.A, SparseMatrixColorings.row_colors(res), bcr) + return Cint(0) +end + +function _compress_impl!( + res::SmcResult{s,:bidirectional,d}, + ::Type{R}, + nzval::Ptr{Cvoid}, + Br::Ptr{Cvoid}, + Bc::Ptr{Cvoid}, + brr::Int, + brc::Int, + bcr::Int, + bcc::Int, +) where {s,d,R} + v = Ptr{R}(nzval) + Brp = Ptr{R}(Br) + Bcp = Ptr{R}(Bc) + _zero_fill!(Brp, brr * brc) + _zero_fill!(Bcp, bcr * bcc) + _accumulate_rows!(Brp, v, res.A, SparseMatrixColorings.row_colors(res), brr) + _accumulate_columns!(Bcp, v, res.A, SparseMatrixColorings.column_colors(res), bcr) + return Cint(0) +end + +## Decompression. `decompress!` is trim-friendly and is used stock. + +function _typed_decompress!( + res, + dtype::Cint, + Br::Ptr{Cvoid}, + Br_len::Csize_t, + Bc::Ptr{Cvoid}, + Bc_len::Csize_t, + A_out::Ptr{Cvoid}, + A_len::Csize_t, +) + A_out == C_NULL && return Cint(-3) + # `_decompress_impl!` wraps an m-by-n `Matrix` over A_out and that wrap + # believes whatever size it is given, so Julia's bounds checks cannot help. + A_len < Csize_t(size(res.A, 1) * size(res.A, 2)) && return Cint(-3) + rc = _check_compressed(res, Br, Br_len, Bc, Bc_len) + rc == Cint(0) || return rc + brr, brc, bcr, bcc = _compressed_dims(res) + if dtype == SMC_FLOAT64 + return _decompress_impl!(res, Float64, Br, Bc, A_out, brr, brc, bcr, bcc) + else + return _decompress_impl!(res, Float32, Br, Bc, A_out, brr, brc, bcr, bcc) + end +end + +function _decompress_impl!( + res::SmcResult{s,:column,d}, + ::Type{R}, + Br::Ptr{Cvoid}, + Bc::Ptr{Cvoid}, + A_out::Ptr{Cvoid}, + brr::Int, + brc::Int, + bcr::Int, + bcc::Int, +) where {s,d,R} + B = _wrap_matrix(R, Bc, bcr, bcc) + A = unsafe_wrap(Matrix{R}, Ptr{R}(A_out), (size(res.A, 1), size(res.A, 2))) + SparseMatrixColorings.decompress!(A, B, res) + return Cint(0) +end + +function _decompress_impl!( + res::SmcResult{s,:row,d}, + ::Type{R}, + Br::Ptr{Cvoid}, + Bc::Ptr{Cvoid}, + A_out::Ptr{Cvoid}, + brr::Int, + brc::Int, + bcr::Int, + bcc::Int, +) where {s,d,R} + B = _wrap_matrix(R, Bc, bcr, bcc) + A = unsafe_wrap(Matrix{R}, Ptr{R}(A_out), (size(res.A, 1), size(res.A, 2))) + SparseMatrixColorings.decompress!(A, B, res) + return Cint(0) +end + +function _decompress_impl!( + res::SmcResult{s,:bidirectional,d}, + ::Type{R}, + Br::Ptr{Cvoid}, + Bc::Ptr{Cvoid}, + A_out::Ptr{Cvoid}, + brr::Int, + brc::Int, + bcr::Int, + bcc::Int, +) where {s,d,R} + Brm = _wrap_matrix(R, Br, brr, brc) + Bcm = _wrap_matrix(R, Bc, bcr, bcc) + A = unsafe_wrap(Matrix{R}, Ptr{R}(A_out), (size(res.A, 1), size(res.A, 2))) + SparseMatrixColorings.decompress!(A, Brm, Bcm, res) + return Cint(0) +end + +# Handle dispatch — one `_do_*` per C entry point that takes a handle. The +# handle is validated first, so a stale or bogus handle is -4 whatever the state +# of the other arguments; only then are the buffers checked (-3), and only then +# does the partition decide whether the question makes sense at all (-2). + +function _do_ncolors(handle::Ptr{Cvoid}, ncolors_out::Ptr{Cint}) + key = _result_key(handle) + key == KEY_INVALID && return Cint(-4) + return @key_dispatch key handle _typed_ncolors ncolors_out +end + +function _do_column_colors!(handle::Ptr{Cvoid}, colors::Ptr{Cint}, len::Cint) + key = _result_key(handle) + key == KEY_INVALID && return Cint(-4) + return @key_dispatch key handle _typed_column_colors! colors len +end + +function _do_row_colors!(handle::Ptr{Cvoid}, colors::Ptr{Cint}, len::Cint) + key = _result_key(handle) + key == KEY_INVALID && return Cint(-4) + return @key_dispatch key handle _typed_row_colors! colors len +end + +function _do_ncolumn_groups(handle::Ptr{Cvoid}, ngroups_out::Ptr{Cint}) + key = _result_key(handle) + key == KEY_INVALID && return Cint(-4) + return @key_dispatch key handle _typed_ncolumn_groups ngroups_out +end + +function _do_nrow_groups(handle::Ptr{Cvoid}, ngroups_out::Ptr{Cint}) + key = _result_key(handle) + key == KEY_INVALID && return Cint(-4) + return @key_dispatch key handle _typed_nrow_groups ngroups_out +end + +function _do_column_group_size(handle::Ptr{Cvoid}, group::Cint, size_out::Ptr{Cint}) + key = _result_key(handle) + key == KEY_INVALID && return Cint(-4) + return @key_dispatch key handle _typed_column_group_size group size_out +end + +function _do_column_group!(handle::Ptr{Cvoid}, group::Cint, members::Ptr{Cint}, len::Cint) + key = _result_key(handle) + key == KEY_INVALID && return Cint(-4) + base = _result_base(handle) + return @key_dispatch key handle _typed_column_group! group members len base +end + +function _do_row_group_size(handle::Ptr{Cvoid}, group::Cint, size_out::Ptr{Cint}) + key = _result_key(handle) + key == KEY_INVALID && return Cint(-4) + return @key_dispatch key handle _typed_row_group_size group size_out +end + +function _do_row_group!(handle::Ptr{Cvoid}, group::Cint, members::Ptr{Cint}, len::Cint) + key = _result_key(handle) + key == KEY_INVALID && return Cint(-4) + base = _result_base(handle) + return @key_dispatch key handle _typed_row_group! group members len base +end + +function _do_nnz(handle::Ptr{Cvoid}, nnz_out::Ptr{Cint}) + key = _result_key(handle) + key == KEY_INVALID && return Cint(-4) + return @key_dispatch key handle _typed_nnz nnz_out +end + +function _do_size(handle::Ptr{Cvoid}, m_out::Ptr{Cint}, n_out::Ptr{Cint}) + key = _result_key(handle) + key == KEY_INVALID && return Cint(-4) + return @key_dispatch key handle _typed_size m_out n_out +end + +function _do_compressed_size( + handle::Ptr{Cvoid}, + br_rows::Ptr{Cint}, + br_cols::Ptr{Cint}, + bc_rows::Ptr{Cint}, + bc_cols::Ptr{Cint}, +) + key = _result_key(handle) + key == KEY_INVALID && return Cint(-4) + return @key_dispatch key handle _typed_compressed_size br_rows br_cols bc_rows bc_cols +end + +function _do_compress!( + handle::Ptr{Cvoid}, + nzval::Ptr{Cvoid}, + nzval_len::Csize_t, + Br::Ptr{Cvoid}, + Br_len::Csize_t, + Bc::Ptr{Cvoid}, + Bc_len::Csize_t, +) + key = _result_key(handle) + key == KEY_INVALID && return Cint(-4) + dtype = Cint(key & 0x01) # the dtype bit of the combo key + return @key_dispatch key handle _typed_compress! dtype nzval nzval_len Br Br_len Bc Bc_len +end + +function _do_decompress!( + handle::Ptr{Cvoid}, + Br::Ptr{Cvoid}, + Br_len::Csize_t, + Bc::Ptr{Cvoid}, + Bc_len::Csize_t, + A_out::Ptr{Cvoid}, + A_len::Csize_t, +) + key = _result_key(handle) + key == KEY_INVALID && return Cint(-4) + dtype = Cint(key & 0x01) + return @key_dispatch key handle _typed_decompress! dtype Br Br_len Bc Bc_len A_out A_len +end + +function _do_free!(handle::Ptr{Cvoid}) + key = _result_key(handle) + key == KEY_INVALID && return Cint(-4) + ret = @store_dispatch key handle _unregister! handle + delete!(result_key_store, handle) + delete!(result_base_store, handle) + return ret +end diff --git a/interfaces/test/C/test_api.c b/interfaces/test/C/test_api.c new file mode 100644 index 00000000..f7493273 --- /dev/null +++ b/interfaces/test/C/test_api.c @@ -0,0 +1,646 @@ +/* + * test_api.c - ABI and error-path tests for the libsmc C interface. + * + * Covers the struct layout and enum values (a drift between smc.h and + * c_enums.jl is silent memory corruption otherwise), the return codes -2/-3/-4, + * the sizing queries, and every buffer length of compress/decompress. + * test_coloring.c checks that the colorings themselves are correct. + * + * Compile (after building libsmc with juliac - see interfaces/README.md): + * gcc -O2 -o interfaces/build/test_api interfaces/test/C/test_api.c \ + * -I interfaces/build/include interfaces/build/lib/libsmc.so \ + * -Wl,-rpath,'$ORIGIN/lib' -lm + * + * Exit code: 0 if all tests pass, 1 otherwise. + */ + +#include +#include +#include +#include +#include + +#include "smc.h" + +static int n_pass = 0, n_fail = 0; + +#define CHECK(cond, msg) \ + do { \ + if (cond) { \ + n_pass++; \ + } else { \ + n_fail++; \ + printf(" FAIL %s (%s:%d)\n", msg, __FILE__, __LINE__); \ + } \ + } while (0) + +/* Compile-time assertion that does not require C11. */ +#define SMC_STATIC_ASSERT(cond, name) \ + typedef char smc_static_assert_##name[(cond) ? 1 : -1] + +/* The layout of SmcColoringOptions is part of the contract: checked at compile + time (a mismatched header fails the build) and again at run time. */ + +SMC_STATIC_ASSERT(sizeof(SmcColoringOptions) == 8 * sizeof(int), options_size); +SMC_STATIC_ASSERT(offsetof(SmcColoringOptions, structure) == 0 * sizeof(int), f0); +SMC_STATIC_ASSERT(offsetof(SmcColoringOptions, partition) == 1 * sizeof(int), f1); +SMC_STATIC_ASSERT(offsetof(SmcColoringOptions, decompression) == 2 * sizeof(int), f2); +SMC_STATIC_ASSERT(offsetof(SmcColoringOptions, order) == 3 * sizeof(int), f3); +SMC_STATIC_ASSERT(offsetof(SmcColoringOptions, postprocessing) == 4 * sizeof(int), f4); +SMC_STATIC_ASSERT(offsetof(SmcColoringOptions, symmetric_pattern) == 5 * sizeof(int), f5); +SMC_STATIC_ASSERT(offsetof(SmcColoringOptions, index_base) == 6 * sizeof(int), f6); +SMC_STATIC_ASSERT(offsetof(SmcColoringOptions, dtype) == 7 * sizeof(int), f7); + +SMC_STATIC_ASSERT(SMC_FLOAT64 == 0 && SMC_FLOAT32 == 1, dtype_values); +SMC_STATIC_ASSERT(SMC_NONSYMMETRIC == 0 && SMC_SYMMETRIC == 1, structure_values); +SMC_STATIC_ASSERT(SMC_COLUMN == 0 && SMC_ROW == 1 && SMC_BIDIRECTIONAL == 2, partition_values); +SMC_STATIC_ASSERT(SMC_DIRECT == 0 && SMC_SUBSTITUTION == 1, decompression_values); +SMC_STATIC_ASSERT(SMC_NATURAL == 0 && SMC_LARGEST_FIRST == 1 && SMC_SMALLEST_LAST == 2 && + SMC_INCIDENCE_DEGREE == 3 && SMC_DYNAMIC_LARGEST_FIRST == 4, order_values); + +/* The 4x6 pattern of the `compress` docstring, 0-based and 1-based: + * . . 4 6 . 9 + * 1 . . . 7 . + * . 2 . . 8 . + * . 3 5 . . . */ + +#define M 4 +#define N 6 +#define NNZ 9 + +static const int colptr0[N + 1] = { 0, 1, 3, 5, 6, 8, 9 }; +static const int rowval0[NNZ] = { 1, 2, 3, 0, 3, 0, 1, 2, 0 }; +static const double nzval[NNZ] = { 1, 2, 3, 4, 5, 6, 7, 8, 9 }; + +static int colptr1[N + 1]; +static int rowval1[NNZ]; + +static void build_one_based(void) +{ + int j; + for (j = 0; j <= N; j++) colptr1[j] = colptr0[j] + 1; + for (j = 0; j < NNZ; j++) rowval1[j] = rowval0[j] + 1; +} + +/* A 5x5 symmetric pattern with a nonzero diagonal, for the symmetric paths. */ +#define SM 5 +#define SNNZ 13 +static const int scolptr[SM + 1] = { 0, 3, 6, 8, 11, 13 }; +static const int srowval[SNNZ] = { 0, 1, 3, + 0, 1, 2, + 1, 2, + 0, 3, 4, + 3, 4 }; +/* The six supported (structure, partition, decompression) triples. */ +static const int SUPPORTED[6][3] = { + { SMC_NONSYMMETRIC, SMC_COLUMN, SMC_DIRECT }, + { SMC_NONSYMMETRIC, SMC_ROW, SMC_DIRECT }, + { SMC_SYMMETRIC, SMC_COLUMN, SMC_DIRECT }, + { SMC_SYMMETRIC, SMC_COLUMN, SMC_SUBSTITUTION }, + { SMC_NONSYMMETRIC, SMC_BIDIRECTIONAL, SMC_DIRECT }, + { SMC_NONSYMMETRIC, SMC_BIDIRECTIONAL, SMC_SUBSTITUTION } +}; + +/* The sentinel that a rejected call must leave in place. */ +#define SENTINEL (-987.0) + +static void fill_sentinel(double *p, size_t len) +{ + size_t i; + for (i = 0; i < len; i++) p[i] = SENTINEL; +} + +static int all_sentinel(const double *p, size_t len) +{ + size_t i; + for (i = 0; i < len; i++) if (p[i] != SENTINEL) return 0; + return 1; +} + +static void test_abi(void) +{ + SmcColoringOptions o; + const int *base = (const int *) &o; + + printf("ABI (struct layout and enum values) ...\n"); + CHECK(sizeof(SmcColoringOptions) == 8 * sizeof(int), + "sizeof(SmcColoringOptions) == 8 * sizeof(int)"); + + /* Eight consecutive ints, no padding. */ + o.structure = 10; o.partition = 11; o.decompression = 12; o.order = 13; + o.postprocessing = 14; o.symmetric_pattern = 15; o.index_base = 16; o.dtype = 17; + CHECK(base[0] == 10 && base[1] == 11 && base[2] == 12 && base[3] == 13 && + base[4] == 14 && base[5] == 15 && base[6] == 16 && base[7] == 17, + "SmcColoringOptions is eight consecutive ints, in the documented order"); + + CHECK(SMC_FLOAT64 == 0 && SMC_FLOAT32 == 1, "SmcDataType values"); + CHECK(SMC_NONSYMMETRIC == 0 && SMC_SYMMETRIC == 1, "SmcStructure values"); + CHECK(SMC_COLUMN == 0 && SMC_ROW == 1 && SMC_BIDIRECTIONAL == 2, "SmcPartition values"); + CHECK(SMC_DIRECT == 0 && SMC_SUBSTITUTION == 1, "SmcDecompression values"); + CHECK(SMC_NATURAL == 0 && SMC_LARGEST_FIRST == 1 && SMC_SMALLEST_LAST == 2 && + SMC_INCIDENCE_DEGREE == 3 && SMC_DYNAMIC_LARGEST_FIRST == 4, "SmcOrder values"); +} + +static void test_default_options(void) +{ + SmcColoringOptions o = smc_default_options(); + + printf("default options ...\n"); + CHECK(o.structure == SMC_NONSYMMETRIC, "default structure is SMC_NONSYMMETRIC"); + CHECK(o.partition == SMC_COLUMN, "default partition is SMC_COLUMN"); + CHECK(o.decompression == SMC_DIRECT, "default decompression is SMC_DIRECT"); + CHECK(o.order == SMC_NATURAL, "default order is SMC_NATURAL"); + CHECK(o.postprocessing == 0, "default postprocessing is 0"); + CHECK(o.symmetric_pattern == 0, "default symmetric_pattern is 0"); + CHECK(o.index_base == 0, "default index_base is 0"); + CHECK(o.dtype == SMC_FLOAT64, "default dtype is SMC_FLOAT64"); +} + +static void test_version(void) +{ + int major = -1, minor = -1, patch = -1; + + printf("version ...\n"); + smc_version(&major, &minor, &patch); + CHECK(major == SMC_VERSION_MAJOR && minor == SMC_VERSION_MINOR && + patch == SMC_VERSION_PATCH, + "smc_version matches the SMC_VERSION_* macros"); +} + +/* A NULL options pointer must behave exactly like smc_default_options(). */ +static void test_null_options(void) +{ + void *with_null = NULL, *with_defaults = NULL; + SmcColoringOptions o = smc_default_options(); + int a[N], b[N], j, same = 1; + + printf("NULL options ...\n"); + CHECK(smc_coloring(M, N, colptr0, rowval0, NULL, &with_null) == 0, + "smc_coloring accepts NULL options"); + CHECK(smc_coloring(M, N, colptr0, rowval0, &o, &with_defaults) == 0, + "smc_coloring accepts smc_default_options()"); + CHECK(smc_column_colors(with_null, a, N) == 0, "colors with NULL options"); + CHECK(smc_column_colors(with_defaults, b, N) == 0, "colors with explicit defaults"); + for (j = 0; j < N; j++) if (a[j] != b[j]) same = 0; + CHECK(same, "NULL options == smc_default_options()"); + smc_result_free(with_null); + smc_result_free(with_defaults); +} + +static void test_unsupported_combinations(void) +{ + /* The six triples that are not a SparseMatrixColorings problem; see smc.h. */ + static const int combos[6][3] = { + { SMC_NONSYMMETRIC, SMC_COLUMN, SMC_SUBSTITUTION }, + { SMC_NONSYMMETRIC, SMC_ROW, SMC_SUBSTITUTION }, + { SMC_SYMMETRIC, SMC_ROW, SMC_DIRECT }, + { SMC_SYMMETRIC, SMC_ROW, SMC_SUBSTITUTION }, + { SMC_SYMMETRIC, SMC_BIDIRECTIONAL, SMC_DIRECT }, + { SMC_SYMMETRIC, SMC_BIDIRECTIONAL, SMC_SUBSTITUTION } + }; + int k, dt; + + printf("unsupported combinations ...\n"); + for (k = 0; k < 6; k++) { + for (dt = 0; dt < 2; dt++) { + SmcColoringOptions o = smc_default_options(); + void *result = (void *) 0x1; /* poison: must be left untouched */ + int rows[SM], cols[SM], nc = -1, ret; + + o.structure = combos[k][0]; + o.partition = combos[k][1]; + o.decompression = combos[k][2]; + o.dtype = dt; + + ret = smc_coloring(SM, SM, scolptr, srowval, &o, &result); + CHECK(ret == -2, "unsupported combination returns -2"); + + ret = smc_fast_coloring(SM, SM, scolptr, srowval, &o, rows, cols, &nc); + CHECK(ret == -2, "smc_fast_coloring rejects the same combination with -2"); + } + } +} + +static void test_invalid_arguments(void) +{ + SmcColoringOptions o = smc_default_options(); + void *result = NULL; + int colors[N]; + + printf("invalid arguments ...\n"); + CHECK(smc_coloring(M, N, NULL, rowval0, &o, &result) == -3, "NULL colptr returns -3"); + CHECK(smc_coloring(M, N, colptr0, NULL, &o, &result) == -3, "NULL rowval returns -3"); + CHECK(smc_coloring(M, N, colptr0, rowval0, &o, NULL) == -3, "NULL result_out returns -3"); + CHECK(smc_coloring(0, N, colptr0, rowval0, &o, &result) == -3, "m == 0 returns -3"); + CHECK(smc_coloring(M, 0, colptr0, rowval0, &o, &result) == -3, "n == 0 returns -3"); + CHECK(smc_coloring(-1, N, colptr0, rowval0, &o, &result) == -3, "m < 0 returns -3"); + CHECK(result == NULL, "the handle is left untouched when the call fails"); + + { + int f; + for (f = 0; f < 6; f++) { + SmcColoringOptions bad = smc_default_options(); + switch (f) { + case 0: bad.structure = 5; break; + case 1: bad.partition = 9; break; + case 2: bad.decompression = 7; break; + case 3: bad.order = 9; break; + case 4: bad.dtype = 4; break; + default: bad.index_base = 2; break; + } + result = NULL; + CHECK(smc_coloring(M, N, colptr0, rowval0, &bad, &result) == -3, + "out-of-range enum or index_base returns -3"); + CHECK(result == NULL, "no handle is created for a rejected option"); + } + } + + result = NULL; + CHECK(smc_coloring(M, N, colptr0, rowval0, &o, &result) == 0, "reference coloring"); + CHECK(smc_column_colors(result, colors, N - 1) == -3, "len < n returns -3"); + CHECK(smc_column_colors(result, NULL, N) == -3, "NULL colors buffer returns -3"); + CHECK(smc_ncolors(result, NULL) == -3, "NULL ncolors_out returns -3"); + CHECK(smc_ncolumn_groups(result, NULL) == -3, "NULL ngroups_out returns -3"); + CHECK(smc_compressed_size(result, NULL, NULL, NULL, NULL) == -3, + "NULL size outputs return -3"); + { + int ngroups = 0, size = 0, members[N]; + CHECK(smc_ncolumn_groups(result, &ngroups) == 0, "ncolumn_groups"); + CHECK(smc_column_group_size(result, 0, &size) == -3, "group 0 is out of range"); + CHECK(smc_column_group_size(result, ngroups + 1, &size) == -3, + "group ngroups+1 is out of range"); + CHECK(smc_column_group_size(result, 1, &size) == 0 && size > 0, "group 1 has a size"); + CHECK(smc_column_group(result, 1, members, size - 1) == -3, "short group buffer returns -3"); + CHECK(smc_column_group(result, 1, NULL, size) == -3, "NULL group buffer returns -3"); + } + { + int rows[M], nrow_groups = 0; + CHECK(smc_row_colors(result, rows, M) == -2, "smc_row_colors on a column partition returns -2"); + CHECK(smc_nrow_groups(result, &nrow_groups) == -2, "smc_nrow_groups on a column partition returns -2"); + } + smc_result_free(result); +} + +static void test_invalid_handle(void) +{ + SmcColoringOptions o = smc_default_options(); + void *result = NULL, *bogus = (void *) (uintptr_t) 0xdeadbeef0ULL; + int colors[N], value = 0, members[N], null_ret; + double Bc[M * N]; + + printf("invalid and already-freed handles ...\n"); + CHECK(smc_coloring(M, N, colptr0, rowval0, &o, &result) == 0, "coloring for the free test"); + CHECK(smc_result_free(result) == 0, "first free returns 0"); + CHECK(smc_result_free(result) == -4, "double free returns -4"); + + /* Every entry point must reject the stale handle rather than dereference it. */ + CHECK(smc_ncolors(result, &value) == -4, "smc_ncolors after free returns -4"); + CHECK(smc_column_colors(result, colors, N) == -4, "smc_column_colors after free returns -4"); + CHECK(smc_row_colors(result, colors, M) == -4, "smc_row_colors after free returns -4"); + CHECK(smc_ncolumn_groups(result, &value) == -4, "smc_ncolumn_groups after free returns -4"); + CHECK(smc_nrow_groups(result, &value) == -4, "smc_nrow_groups after free returns -4"); + CHECK(smc_column_group_size(result, 1, &value) == -4, "smc_column_group_size after free returns -4"); + CHECK(smc_column_group(result, 1, members, N) == -4, "smc_column_group after free returns -4"); + CHECK(smc_row_group_size(result, 1, &value) == -4, "smc_row_group_size after free returns -4"); + CHECK(smc_row_group(result, 1, members, M) == -4, "smc_row_group after free returns -4"); + CHECK(smc_compressed_size(result, &value, &value, &value, &value) == -4, + "smc_compressed_size after free returns -4"); + CHECK(smc_nnz(result, &value) == -4, "smc_nnz after free returns -4"); + CHECK(smc_size(result, &value, &value) == -4, "smc_size after free returns -4"); + CHECK(smc_compress(result, nzval, (size_t) NNZ, NULL, 0, Bc, (size_t) (M * N)) == -4, + "smc_compress after free returns -4"); + CHECK(smc_decompress(result, NULL, 0, Bc, (size_t) (M * N), Bc, (size_t) (M * N)) == -4, + "smc_decompress after free returns -4"); + + CHECK(smc_result_free(bogus) == -4, "freeing a never-allocated handle returns -4"); + CHECK(smc_ncolors(bogus, &value) == -4, "querying a never-allocated handle returns -4"); + null_ret = smc_result_free(NULL); + CHECK(null_ret == -3 || null_ret == -4, "freeing NULL is rejected, not a crash"); +} + +/* smc_nnz and smc_size are the only way a caller holding nothing but a handle + can size nzval and A_out. */ + +static void test_sizing_queries(void) +{ + int k, dt; + + printf("smc_nnz / smc_size ...\n"); + for (k = 0; k < 6; k++) { + for (dt = 0; dt < 2; dt++) { + SmcColoringOptions o = smc_default_options(); + void *result = NULL; + int symmetric = (SUPPORTED[k][0] == SMC_SYMMETRIC); + int m = symmetric ? SM : M; + int n = symmetric ? SM : N; + int want_nnz = symmetric ? SNNZ : NNZ; + const int *cp = symmetric ? scolptr : colptr0; + const int *rv = symmetric ? srowval : rowval0; + int got_nnz = -1, got_m = -1, got_n = -1; + + o.structure = SUPPORTED[k][0]; + o.partition = SUPPORTED[k][1]; + o.decompression = SUPPORTED[k][2]; + o.dtype = dt; + + CHECK(smc_coloring(m, n, cp, rv, &o, &result) == 0, "coloring for the sizing queries"); + CHECK(smc_nnz(result, &got_nnz) == 0 && got_nnz == want_nnz, + "smc_nnz is the number of stored entries"); + CHECK(smc_size(result, &got_m, &got_n) == 0 && got_m == m && got_n == n, + "smc_size is the shape of the colored matrix"); + + CHECK(smc_nnz(result, NULL) == -3, "NULL nnz_out returns -3"); + CHECK(smc_size(result, NULL, &got_n) == -3, "NULL m_out returns -3"); + CHECK(smc_size(result, &got_m, NULL) == -3, "NULL n_out returns -3"); + + CHECK(smc_result_free(result) == 0, "free"); + CHECK(smc_nnz(result, &got_nnz) == -4, "smc_nnz on a freed handle returns -4"); + CHECK(smc_size(result, &got_m, &got_n) == -4, "smc_size on a freed handle returns -4"); + } + } +} + +/* Buffer lengths are element counts, checked before any element is read or + * written. Each length is understated on its own with the buffer left at full + * size, so a -3 can only come from the length check and a surviving sentinel + * proves the check ran before the write. + * + * Column partition: Br is unused, so NULL with a length of 0 is the documented + * call and only nzval_len, Bc_len and A_len are in play. */ +static void test_buffer_lengths(void) +{ + SmcColoringOptions o = smc_default_options(); + void *result = NULL; + int Br_rows = -1, Br_cols = -1, Bc_rows = -1, Bc_cols = -1; + int nnz = -1, m = -1, n = -1; + size_t bc_len, a_len; + double *Bc, *A; + + printf("buffer lengths (column partition) ...\n"); + CHECK(smc_coloring(M, N, colptr0, rowval0, &o, &result) == 0, "coloring"); + CHECK(smc_nnz(result, &nnz) == 0 && nnz == NNZ, "nnz"); + CHECK(smc_size(result, &m, &n) == 0 && m == M && n == N, "size"); + CHECK(smc_compressed_size(result, &Br_rows, &Br_cols, &Bc_rows, &Bc_cols) == 0, + "compressed size"); + CHECK(Br_rows == 0 && Br_cols == 0, "a column partition has no Br"); + + bc_len = (size_t) Bc_rows * (size_t) Bc_cols; + a_len = (size_t) m * (size_t) n; + Bc = (double *) malloc(sizeof(double) * bc_len); + A = (double *) malloc(sizeof(double) * a_len); + CHECK(Bc != NULL && A != NULL, "allocation"); + if (Bc == NULL || A == NULL) { free(Bc); free(A); smc_result_free(result); return; } + + CHECK(smc_compress(result, nzval, (size_t) nnz, NULL, 0, Bc, bc_len) == 0, + "exact-size compress succeeds"); + CHECK(smc_decompress(result, NULL, 0, Bc, bc_len, A, a_len) == 0, + "exact-size decompress succeeds"); + + fill_sentinel(Bc, bc_len); + CHECK(smc_compress(result, nzval, (size_t) nnz - 1, NULL, 0, Bc, bc_len) == -3, + "nzval_len one element short returns -3"); + CHECK(all_sentinel(Bc, bc_len), "a short nzval_len writes nothing"); + CHECK(smc_compress(result, nzval, 0, NULL, 0, Bc, bc_len) == -3, "nzval_len 0 returns -3"); + CHECK(all_sentinel(Bc, bc_len), "an nzval_len of 0 writes nothing"); + + CHECK(smc_compress(result, nzval, (size_t) nnz, NULL, 0, Bc, bc_len - 1) == -3, + "Bc_len one element short returns -3"); + CHECK(all_sentinel(Bc, bc_len), "a short Bc_len writes nothing"); + CHECK(smc_compress(result, nzval, (size_t) nnz, NULL, 0, Bc, 0) == -3, "Bc_len 0 returns -3"); + CHECK(all_sentinel(Bc, bc_len), "a Bc_len of 0 writes nothing"); + + CHECK(smc_compress(result, NULL, (size_t) nnz, NULL, 0, Bc, bc_len) == -3, + "NULL nzval returns -3"); + CHECK(smc_compress(result, nzval, (size_t) nnz, NULL, 0, NULL, bc_len) == -3, + "NULL Bc returns -3"); + CHECK(all_sentinel(Bc, bc_len), "no NULL-buffer rejection writes anything"); + + /* A larger length is a generous promise, not an error: the comparison is + unsigned and must not wrap. */ + CHECK(smc_compress(result, nzval, SIZE_MAX, NULL, 0, Bc, SIZE_MAX) == 0, + "SIZE_MAX lengths do not wrap into 'too small'"); + + /* Bc now holds the real compressed matrix. */ + fill_sentinel(A, a_len); + CHECK(smc_decompress(result, NULL, 0, Bc, bc_len, A, a_len - 1) == -3, + "A_len one element short returns -3"); + CHECK(all_sentinel(A, a_len), "a short A_len writes nothing"); + CHECK(smc_decompress(result, NULL, 0, Bc, bc_len, A, 0) == -3, "A_len 0 returns -3"); + CHECK(all_sentinel(A, a_len), "an A_len of 0 writes nothing"); + + CHECK(smc_decompress(result, NULL, 0, Bc, bc_len - 1, A, a_len) == -3, + "Bc_len one element short returns -3 in decompress"); + CHECK(all_sentinel(A, a_len), "a short Bc_len leaves A_out alone"); + CHECK(smc_decompress(result, NULL, 0, NULL, bc_len, A, a_len) == -3, + "NULL Bc returns -3 in decompress"); + CHECK(all_sentinel(A, a_len), "a NULL Bc leaves A_out alone"); + CHECK(smc_decompress(result, NULL, 0, Bc, bc_len, NULL, a_len) == -3, + "NULL A_out returns -3"); + + CHECK(smc_decompress(result, NULL, 0, Bc, SIZE_MAX, A, SIZE_MAX) == 0, + "SIZE_MAX lengths are accepted by decompress too"); + + free(Bc); free(A); + smc_result_free(result); +} + +/* Bidirectional partition: Br is required, so all four lengths are in play. */ +static void test_bidirectional_buffer_lengths(void) +{ + SmcColoringOptions o = smc_default_options(); + void *result = NULL; + int Br_rows = -1, Br_cols = -1, Bc_rows = -1, Bc_cols = -1; + int nnz = -1, m = -1, n = -1; + size_t br_len, bc_len, a_len; + double *Br, *Bc, *A; + + printf("buffer lengths (bidirectional partition) ...\n"); + o.partition = SMC_BIDIRECTIONAL; + CHECK(smc_coloring(M, N, colptr0, rowval0, &o, &result) == 0, "bidirectional coloring"); + CHECK(smc_nnz(result, &nnz) == 0 && nnz == NNZ, "nnz"); + CHECK(smc_size(result, &m, &n) == 0 && m == M && n == N, "size"); + CHECK(smc_compressed_size(result, &Br_rows, &Br_cols, &Bc_rows, &Bc_cols) == 0, + "compressed size"); + CHECK(Br_rows > 0 && Br_cols == N, "a bidirectional partition does have a Br"); + + br_len = (size_t) Br_rows * (size_t) Br_cols; + bc_len = (size_t) Bc_rows * (size_t) Bc_cols; + a_len = (size_t) m * (size_t) n; + Br = (double *) malloc(sizeof(double) * br_len); + Bc = (double *) malloc(sizeof(double) * bc_len); + A = (double *) malloc(sizeof(double) * a_len); + CHECK(Br != NULL && Bc != NULL && A != NULL, "allocation"); + if (Br == NULL || Bc == NULL || A == NULL) { + free(Br); free(Bc); free(A); smc_result_free(result); return; + } + + CHECK(smc_compress(result, nzval, (size_t) nnz, Br, br_len, Bc, bc_len) == 0, + "exact-size compress succeeds"); + CHECK(smc_decompress(result, Br, br_len, Bc, bc_len, A, a_len) == 0, + "exact-size decompress succeeds"); + + fill_sentinel(Br, br_len); + fill_sentinel(Bc, bc_len); + CHECK(smc_compress(result, nzval, (size_t) nnz, Br, br_len - 1, Bc, bc_len) == -3, + "Br_len one element short returns -3"); + CHECK(all_sentinel(Br, br_len) && all_sentinel(Bc, bc_len), + "a short Br_len writes nothing, in either buffer"); + CHECK(smc_compress(result, nzval, (size_t) nnz, Br, 0, Bc, bc_len) == -3, + "Br_len 0 returns -3 for a bidirectional result"); + CHECK(all_sentinel(Br, br_len) && all_sentinel(Bc, bc_len), "a Br_len of 0 writes nothing"); + + CHECK(smc_compress(result, nzval, (size_t) nnz, Br, br_len, Bc, bc_len - 1) == -3, + "Bc_len one element short returns -3"); + CHECK(smc_compress(result, nzval, (size_t) nnz - 1, Br, br_len, Bc, bc_len) == -3, + "nzval_len one element short returns -3"); + CHECK(all_sentinel(Br, br_len) && all_sentinel(Bc, bc_len), + "neither short length writes anything"); + + /* Both compressed matrices are required. */ + CHECK(smc_compress(result, nzval, (size_t) nnz, NULL, 0, Bc, bc_len) == -3, + "a bidirectional result rejects a NULL Br"); + CHECK(smc_compress(result, nzval, (size_t) nnz, Br, br_len, NULL, 0) == -3, + "a bidirectional result rejects a NULL Bc"); + CHECK(all_sentinel(Br, br_len) && all_sentinel(Bc, bc_len), "no NULL rejection writes"); + + CHECK(smc_compress(result, nzval, (size_t) nnz, Br, br_len, Bc, bc_len) == 0, + "compress again, for the decompress checks"); + + fill_sentinel(A, a_len); + CHECK(smc_decompress(result, Br, br_len - 1, Bc, bc_len, A, a_len) == -3, + "Br_len one element short returns -3 in decompress"); + CHECK(all_sentinel(A, a_len), "a short Br_len leaves A_out alone"); + CHECK(smc_decompress(result, Br, br_len, Bc, bc_len - 1, A, a_len) == -3, + "Bc_len one element short returns -3 in decompress"); + CHECK(all_sentinel(A, a_len), "a short Bc_len leaves A_out alone"); + CHECK(smc_decompress(result, Br, br_len, Bc, bc_len, A, a_len - 1) == -3, + "A_len one element short returns -3 in decompress"); + CHECK(all_sentinel(A, a_len), "a short A_len leaves A_out alone"); + CHECK(smc_decompress(result, NULL, 0, Bc, bc_len, A, a_len) == -3, + "a bidirectional result rejects a NULL Br in decompress"); + CHECK(all_sentinel(A, a_len), "a NULL Br leaves A_out alone"); + + CHECK(smc_decompress(result, Br, br_len, Bc, bc_len, A, a_len) == 0, + "the exact sizes still work after every rejection"); + + free(Br); free(Bc); free(A); + smc_result_free(result); +} + +/* index_base shifts the pattern indices and the group members, never the + colors: same matrix, same coloring. */ +static void test_index_base(void) +{ + SmcColoringOptions o0 = smc_default_options(); + SmcColoringOptions o1 = smc_default_options(); + void *r0 = NULL, *r1 = NULL; + int c0[N], c1[N], nc0 = 0, nc1 = 0, g0 = 0, g1 = 0, j, same = 1, shifted = 1; + + printf("index_base 0 vs 1 ...\n"); + o1.index_base = 1; + + CHECK(smc_coloring(M, N, colptr0, rowval0, &o0, &r0) == 0, "0-based coloring"); + CHECK(smc_coloring(M, N, colptr1, rowval1, &o1, &r1) == 0, "1-based coloring"); + + smc_ncolors(r0, &nc0); + smc_ncolors(r1, &nc1); + CHECK(nc0 == nc1 && nc0 > 0, "same number of colors"); + + smc_column_colors(r0, c0, N); + smc_column_colors(r1, c1, N); + for (j = 0; j < N; j++) if (c0[j] != c1[j]) same = 0; + CHECK(same, "identical column colors (colors are labels, not indices)"); + + smc_ncolumn_groups(r0, &g0); + smc_ncolumn_groups(r1, &g1); + CHECK(g0 == g1, "same number of groups"); + for (j = 1; j <= g0; j++) { + int s0 = 0, s1 = 0, k, m0[N], m1[N]; + smc_column_group_size(r0, j, &s0); + smc_column_group_size(r1, j, &s1); + if (s0 != s1) { shifted = 0; break; } + smc_column_group(r0, j, m0, s0); + smc_column_group(r1, j, m1, s1); + for (k = 0; k < s0; k++) if (m1[k] != m0[k] + 1) shifted = 0; + } + CHECK(shifted, "group members are shifted by exactly the index base"); + + smc_result_free(r0); + smc_result_free(r1); +} + +static void test_float32(void) +{ + SmcColoringOptions o = smc_default_options(); + void *result = NULL; + int Br_rows = -1, Br_cols = -1, Bc_rows = -1, Bc_cols = -1, i, j, k, exact = 1; + int nnz = -1, m = -1, n = -1, intact = 1; + size_t bc_len, a_len; + float nzval32[NNZ], *Bc, A[M * N], expected[M * N]; + + printf("Float32 compress / decompress ...\n"); + o.dtype = SMC_FLOAT32; + CHECK(smc_coloring(M, N, colptr0, rowval0, &o, &result) == 0, "Float32 coloring"); + CHECK(smc_nnz(result, &nnz) == 0 && nnz == NNZ, "nnz"); + CHECK(smc_size(result, &m, &n) == 0 && m == M && n == N, "size"); + CHECK(smc_compressed_size(result, &Br_rows, &Br_cols, &Bc_rows, &Bc_cols) == 0, + "compressed size"); + CHECK(Br_rows == 0 && Br_cols == 0, "Br is unused for a column partition"); + CHECK(Bc_rows == M, "Bc has m rows"); + + /* Lengths are element counts, so they match the Float64 numbers. */ + bc_len = (size_t) Bc_rows * (size_t) Bc_cols; + a_len = (size_t) m * (size_t) n; + + for (k = 0; k < NNZ; k++) nzval32[k] = (float) nzval[k]; + Bc = (float *) malloc(sizeof(float) * bc_len); + CHECK(Bc != NULL, "allocation"); + CHECK(smc_compress(result, nzval32, (size_t) nnz, NULL, 0, Bc, bc_len) == 0, + "Float32 compress"); + CHECK(smc_compress(result, nzval32, (size_t) nnz - 1, NULL, 0, Bc, bc_len) == -3, + "a short nzval_len is rejected on the Float32 path too"); + CHECK(smc_compress(result, nzval32, (size_t) nnz, NULL, 0, Bc, bc_len - 1) == -3, + "a short Bc_len is rejected on the Float32 path too"); + + for (k = 0; k < M * N; k++) A[k] = -987.0f; + CHECK(smc_decompress(result, NULL, 0, Bc, bc_len, A, a_len - 1) == -3, + "a short A_len is rejected on the Float32 path too"); + for (k = 0; k < M * N; k++) if (A[k] != -987.0f) intact = 0; + CHECK(intact, "a short A_len leaves the Float32 A_out untouched"); + CHECK(smc_decompress(result, NULL, 0, Bc, bc_len, A, a_len) == 0, "Float32 decompress"); + + /* Reference dense matrix, column-major. */ + for (k = 0; k < M * N; k++) expected[k] = 0.0f; + for (j = 0; j < N; j++) + for (k = colptr0[j]; k < colptr0[j + 1]; k++) + expected[j * M + rowval0[k]] = (float) nzval[k]; + + for (j = 0; j < N; j++) + for (i = 0; i < M; i++) + if (A[j * M + i] != expected[j * M + i]) exact = 0; + CHECK(exact, "Float32 compress -> decompress reproduces every entry exactly"); + + free(Bc); + smc_result_free(result); +} + +int main(void) +{ + build_one_based(); + + test_abi(); + test_default_options(); + test_version(); + test_null_options(); + test_unsupported_combinations(); + test_invalid_arguments(); + test_invalid_handle(); + test_sizing_queries(); + test_buffer_lengths(); + test_bidirectional_buffer_lengths(); + test_index_base(); + test_float32(); + + printf("\n%d checks passed, %d failed\n", n_pass, n_fail); + return n_fail > 0 ? 1 : 0; +} diff --git a/interfaces/test/C/test_coloring.c b/interfaces/test/C/test_coloring.c new file mode 100644 index 00000000..5af28f42 --- /dev/null +++ b/interfaces/test/C/test_coloring.c @@ -0,0 +1,725 @@ +/* + * test_coloring.c - correctness tests for the colorings produced by libsmc. + * + * Nothing is compared against a hard-coded expected coloring: a greedy coloring + * may legitimately change with the vertex order, so each coloring is verified + * against the structural property that makes it usable, over all five orders, + * both postprocessing settings and both dtypes. + * + * Compile (after building libsmc with juliac - see interfaces/README.md): + * gcc -O2 -o interfaces/build/test_coloring interfaces/test/C/test_coloring.c \ + * -I interfaces/build/include interfaces/build/lib/libsmc.so \ + * -Wl,-rpath,'$ORIGIN/lib' -lm + * + * Exit code: 0 if all tests pass, 1 otherwise. + */ + +#include +#include +#include +#include + +#include "smc.h" + +static int n_pass = 0, n_fail = 0; + +#define CHECK(cond, msg) \ + do { \ + if (cond) { \ + n_pass++; \ + } else { \ + n_fail++; \ + printf(" FAIL %s (%s:%d)\n", msg, __FILE__, __LINE__); \ + } \ + } while (0) + +#define MAXDIM 12 +#define MAXNNZ 64 + +/* A sparsity pattern with values, in CSC form, 0-based. */ +typedef struct { + const char *name; + int m; + int n; + const int *colptr; /* n + 1 entries */ + const int *rowval; /* colptr[n] entries */ + const double *nzval; /* colptr[n] entries */ +} Matrix; + +/* 4x6 rectangular, nonsymmetric (the `compress` docstring matrix): + * . . 4 6 . 9 + * 1 . . . 7 . + * . 2 . . 8 . + * . 3 5 . . . */ +static const int ns_colptr[7] = { 0, 1, 3, 5, 6, 8, 9 }; +static const int ns_rowval[9] = { 1, 2, 3, 0, 3, 0, 1, 2, 0 }; +static const double ns_nzval[9] = { 1, 2, 3, 4, 5, 6, 7, 8, 9 }; + +/* 7x5 rectangular with denser rows and columns. */ +static const int ns2_colptr[6] = { 0, 4, 7, 10, 13, 16 }; +static const int ns2_rowval[16] = { 0, 1, 4, 6, + 1, 2, 5, + 2, 3, 6, + 0, 3, 4, + 1, 4, 5 }; +static const double ns2_nzval[16] = { 1, 3, 2, 7, + 4, 6, 5, + 7, 8, 8, + 2, 9, 3, + 5, 4, 6 }; + +/* 7x7 symmetric, nonzero diagonal: tridiagonal plus the (1,7) corner. */ +static const int sym_colptr[8] = { 0, 3, 6, 9, 12, 15, 18, 21 }; +static const int sym_rowval[21] = { 0, 1, 6, + 0, 1, 2, + 1, 2, 3, + 2, 3, 4, + 3, 4, 5, + 4, 5, 6, + 0, 5, 6 }; +static const double sym_nzval[21] = { 2, 1, 3, + 1, 2, 1, + 1, 2, 1, + 1, 2, 1, + 1, 2, 1, + 1, 2, 1, + 3, 1, 2 }; + +/* 6x6 symmetric with a zero diagonal (the 3-cube minus a perfect matching); + a zero diagonal is what lets postprocessing hand out the neutral color 0. */ +static const int sym0_colptr[7] = { 0, 2, 4, 6, 8, 10, 12 }; +static const int sym0_rowval[12] = { 1, 2, + 0, 3, + 0, 4, + 1, 5, + 2, 5, + 3, 4 }; +static const double sym0_nzval[12] = { 1, 2, + 1, 3, + 2, 4, + 3, 5, + 4, 6, + 5, 6 }; + +static const Matrix NONSYM_MATRICES[2] = { + { "nonsym 4x6", 4, 6, ns_colptr, ns_rowval, ns_nzval }, + { "nonsym 7x5", 7, 5, ns2_colptr, ns2_rowval, ns2_nzval } +}; + +static const Matrix SYM_MATRICES[2] = { + { "sym 7x7 (full diagonal)", 7, 7, sym_colptr, sym_rowval, sym_nzval }, + { "sym 6x6 (zero diagonal)", 6, 6, sym0_colptr, sym0_rowval, sym0_nzval } +}; + +/* Dense column-major copy of the matrix. */ +static void to_dense(const Matrix *A, double *dense) +{ + int i, j, k; + for (k = 0; k < A->m * A->n; k++) dense[k] = 0.0; + for (j = 0; j < A->n; j++) + for (k = A->colptr[j]; k < A->colptr[j + 1]; k++) { + i = A->rowval[k]; + dense[j * A->m + i] = A->nzval[k]; + } +} + +#define NZ(dense, m, i, j) ((dense)[(j) * (m) + (i)] != 0.0) + +/* Two columns of the same nonzero color must have disjoint row supports. */ +static int column_colors_are_disjoint(const double *dense, int m, int n, const int *colors) +{ + int i, j, k; + for (j = 0; j < n; j++) + for (k = j + 1; k < n; k++) { + if (colors[j] == 0 || colors[k] == 0) continue; + if (colors[j] != colors[k]) continue; + for (i = 0; i < m; i++) + if (NZ(dense, m, i, j) && NZ(dense, m, i, k)) return 0; + } + return 1; +} + +/* Same statement on the rows. */ +static int row_colors_are_disjoint(const double *dense, int m, int n, const int *colors) +{ + int i, j, k; + for (i = 0; i < m; i++) + for (k = i + 1; k < m; k++) { + if (colors[i] == 0 || colors[k] == 0) continue; + if (colors[i] != colors[k]) continue; + for (j = 0; j < n; j++) + if (NZ(dense, m, i, j) && NZ(dense, m, k, j)) return 0; + } + return 1; +} + +/* Adjacent vertices carry different nonzero colors. */ +static int is_proper(const double *dense, int n, const int *colors) +{ + int i, j; + for (j = 0; j < n; j++) + for (i = 0; i < j; i++) { + if (!NZ(dense, n, i, j)) continue; + if (colors[i] == 0 || colors[j] == 0) continue; + if (colors[i] == colors[j]) return 0; + } + return 1; +} + +/* No path i - j - k - l uses only two colors (star coloring). */ +static int is_star_coloring(const double *dense, int n, const int *colors) +{ + int i, j, k, l; + for (j = 0; j < n; j++) + for (k = 0; k < n; k++) { + if (j == k || !NZ(dense, n, j, k)) continue; + for (i = 0; i < n; i++) { + if (i == j || i == k || !NZ(dense, n, i, j)) continue; + for (l = 0; l < n; l++) { + if (l == i || l == j || l == k || !NZ(dense, n, k, l)) continue; + if (colors[i] == 0 || colors[j] == 0 || colors[k] == 0 || colors[l] == 0) continue; + if (colors[i] == colors[k] && colors[j] == colors[l]) return 0; + } + } + } + return 1; +} + +static int uf_find(int *parent, int x) +{ + while (parent[x] != x) { parent[x] = parent[parent[x]]; x = parent[x]; } + return x; +} + +/* Every subgraph induced by two colors is a forest (acyclic coloring). */ +static int is_acyclic_coloring(const double *dense, int n, const int *colors, int ncolors) +{ + int ca, cb, i, j, parent[MAXDIM]; + for (ca = 1; ca <= ncolors; ca++) + for (cb = ca + 1; cb <= ncolors; cb++) { + for (i = 0; i < n; i++) parent[i] = i; + for (j = 0; j < n; j++) + for (i = 0; i < j; i++) { + int ri, rj; + if (!NZ(dense, n, i, j)) continue; + if (!((colors[i] == ca && colors[j] == cb) || + (colors[i] == cb && colors[j] == ca))) continue; + ri = uf_find(parent, i); + rj = uf_find(parent, j); + if (ri == rj) return 0; /* a cycle inside {ca, cb} */ + parent[ri] = rj; + } + } + return 1; +} + +/* Every nonzero must be readable off the compressed matrix: A[i][j] is either + the only nonzero of row i among the columns of its color, or the only nonzero + of column j among the rows of its color. Pass NULL for the coloring that the + partition does not produce. */ +static int is_directly_recoverable(const double *dense, int m, int n, + const int *row_colors, const int *column_colors) +{ + int i, j, k; + for (j = 0; j < n; j++) + for (i = 0; i < m; i++) { + int by_column = 0, by_row = 0; + if (!NZ(dense, m, i, j)) continue; + if (column_colors != NULL && column_colors[j] != 0) { + by_column = 1; + for (k = 0; k < n; k++) + if (k != j && NZ(dense, m, i, k) && column_colors[k] == column_colors[j]) by_column = 0; + } + if (row_colors != NULL && row_colors[i] != 0) { + by_row = 1; + for (k = 0; k < m; k++) + if (k != i && NZ(dense, m, k, j) && row_colors[k] == row_colors[i]) by_row = 0; + } + if (!by_column && !by_row) return 0; + } + return 1; +} + +/* Symmetric counterpart: A[i][j] is read from B[i][colors[j]] when column j is + the only one of its color meeting row i, or - by symmetry - from + B[j][colors[i]]. */ +static int is_symmetrically_recoverable(const double *dense, int n, const int *colors) +{ + int i, j, k; + for (j = 0; j < n; j++) + for (i = 0; i < n; i++) { + int by_j = 0, by_i = 0; + if (!NZ(dense, n, i, j)) continue; + if (colors[j] != 0) { + by_j = 1; + for (k = 0; k < n; k++) + if (k != j && NZ(dense, n, i, k) && colors[k] == colors[j]) by_j = 0; + } + if (colors[i] != 0) { + by_i = 1; + for (k = 0; k < n; k++) + if (k != i && NZ(dense, n, j, k) && colors[k] == colors[i]) by_i = 0; + } + if (!by_j && !by_i) return 0; + } + return 1; +} + +/* The groups are exactly the color classes. */ +static int groups_match_colors(void *result, int ngroups, const int *colors, int len, + int base, int column) +{ + int g, k, seen[MAXDIM]; + for (k = 0; k < len; k++) seen[k] = 0; + + for (g = 1; g <= ngroups; g++) { + int size = 0, members[MAXDIM]; + int ret = column ? smc_column_group_size(result, g, &size) + : smc_row_group_size(result, g, &size); + if (ret != 0 || size < 0 || size > len) return 0; + ret = column ? smc_column_group(result, g, members, size) + : smc_row_group(result, g, members, size); + if (ret != 0) return 0; + for (k = 0; k < size; k++) { + int index = members[k] - base; + if (index < 0 || index >= len) return 0; + if (seen[index]) return 0; /* a member of two groups */ + seen[index] = 1; + if (colors[index] != g) return 0; /* wrong group */ + } + } + /* Every non-neutral index belongs to exactly one group, and only those. */ + for (k = 0; k < len; k++) { + if (colors[k] != 0 && !seen[k]) return 0; + if (colors[k] == 0 && seen[k]) return 0; + if (colors[k] < 0 || colors[k] > ngroups) return 0; + } + return 1; +} + +/* The lengths smc_compress and smc_decompress need, read back from the API + rather than from the Matrix struct, which also checks that smc_nnz and + smc_size agree with the pattern that was colored. 0 if any query fails. */ +static int query_lengths(void *result, const Matrix *A, + int *Br_rows, int *Br_cols, int *Bc_rows, int *Bc_cols, + size_t *br_len, size_t *bc_len, size_t *a_len, size_t *nzval_len) +{ + int nnz = -1, m = -1, n = -1; + + if (smc_compressed_size(result, Br_rows, Br_cols, Bc_rows, Bc_cols) != 0) return 0; + if (smc_nnz(result, &nnz) != 0 || nnz != A->colptr[A->n]) return 0; + if (smc_size(result, &m, &n) != 0 || m != A->m || n != A->n) return 0; + + *br_len = (size_t) *Br_rows * (size_t) *Br_cols; + *bc_len = (size_t) *Bc_rows * (size_t) *Bc_cols; + *a_len = (size_t) m * (size_t) n; + *nzval_len = (size_t) nnz; + return 1; +} + +/* Float64 round trip; returns 1 when every entry of A is reproduced. */ +static int roundtrip_f64(void *result, const Matrix *A, int exact) +{ + int Br_rows = -1, Br_cols = -1, Bc_rows = -1, Bc_cols = -1, i, j, ok = 1; + size_t br_len, bc_len, a_len, nzval_len, k; + double *Br = NULL, *Bc = NULL, *out = NULL, dense[MAXDIM * MAXDIM]; + + if (!query_lengths(result, A, &Br_rows, &Br_cols, &Bc_rows, &Bc_cols, + &br_len, &bc_len, &a_len, &nzval_len)) return 0; + + if (br_len > 0) Br = (double *) malloc(sizeof(double) * br_len); + Bc = (double *) malloc(sizeof(double) * bc_len); + out = (double *) malloc(sizeof(double) * a_len); + if (Bc == NULL || out == NULL || (br_len > 0 && Br == NULL)) { + free(Br); free(Bc); free(out); return 0; + } + + for (k = 0; k < br_len; k++) Br[k] = -987.0; + for (k = 0; k < bc_len; k++) Bc[k] = -987.0; + for (k = 0; k < a_len; k++) out[k] = -987.0; + + if (smc_compress(result, A->nzval, nzval_len, Br, br_len, Bc, bc_len) != 0) ok = 0; + if (smc_decompress(result, Br, br_len, Bc, bc_len, out, a_len) != 0) ok = 0; + + to_dense(A, dense); + for (j = 0; ok && j < A->n; j++) + for (i = 0; i < A->m; i++) { + double expected = dense[j * A->m + i]; + double got = out[j * A->m + i]; + if (exact ? (got != expected) : (fabs(got - expected) > 1e-9 * (1.0 + fabs(expected)))) + ok = 0; + } + + free(Br); free(Bc); free(out); + return ok; +} + +/* Float32 round trip on a handle created with dtype == SMC_FLOAT32. */ +static int roundtrip_f32(void *result, const Matrix *A, int exact) +{ + int Br_rows = -1, Br_cols = -1, Bc_rows = -1, Bc_cols = -1, i, j, ok = 1; + size_t br_len, bc_len, a_len, nzval_len, k; + float *Br = NULL, *Bc = NULL, *out = NULL, nzval32[MAXNNZ]; + double dense[MAXDIM * MAXDIM]; + + if (!query_lengths(result, A, &Br_rows, &Br_cols, &Bc_rows, &Bc_cols, + &br_len, &bc_len, &a_len, &nzval_len)) return 0; + for (k = 0; k < nzval_len; k++) nzval32[k] = (float) A->nzval[k]; + + if (br_len > 0) Br = (float *) malloc(sizeof(float) * br_len); + Bc = (float *) malloc(sizeof(float) * bc_len); + out = (float *) malloc(sizeof(float) * a_len); + if (Bc == NULL || out == NULL || (br_len > 0 && Br == NULL)) { + free(Br); free(Bc); free(out); return 0; + } + + for (k = 0; k < br_len; k++) Br[k] = -987.0f; + for (k = 0; k < bc_len; k++) Bc[k] = -987.0f; + for (k = 0; k < a_len; k++) out[k] = -987.0f; + + /* Lengths are element counts, so they match the Float64 numbers. */ + if (smc_compress(result, nzval32, nzval_len, Br, br_len, Bc, bc_len) != 0) ok = 0; + if (smc_decompress(result, Br, br_len, Bc, bc_len, out, a_len) != 0) ok = 0; + + to_dense(A, dense); + for (j = 0; ok && j < A->n; j++) + for (i = 0; i < A->m; i++) { + float expected = (float) dense[j * A->m + i]; + float got = out[j * A->m + i]; + if (exact ? (got != expected) : (fabsf(got - expected) > 1e-4f * (1.0f + fabsf(expected)))) + ok = 0; + } + + free(Br); free(Bc); free(out); + return ok; +} + +/* Every buffer length, one element short, one at a time. Each buffer keeps its + full size and is pre-filled, so a -3 can only come from the length check and a + surviving sentinel proves the check ran before any element was written. */ +static int length_guards_ok(void *result, const Matrix *A) +{ + int Br_rows = -1, Br_cols = -1, Bc_rows = -1, Bc_cols = -1, ok = 1; + int bidirectional; + size_t br_len, bc_len, a_len, nzval_len, k; + double *Br = NULL, *Bc = NULL, *out = NULL; + + if (!query_lengths(result, A, &Br_rows, &Br_cols, &Bc_rows, &Bc_cols, + &br_len, &bc_len, &a_len, &nzval_len)) return 0; + /* Br_cols identifies the partition; br_len does not, since postprocessing can + leave zero row groups and make Br 0-by-n. */ + bidirectional = (Br_cols > 0); + + if (bidirectional) Br = (double *) malloc(sizeof(double) * (br_len ? br_len : 1)); + Bc = (double *) malloc(sizeof(double) * (bc_len ? bc_len : 1)); + out = (double *) malloc(sizeof(double) * (a_len ? a_len : 1)); + if (Bc == NULL || out == NULL || (bidirectional && Br == NULL)) { + free(Br); free(Bc); free(out); return 0; + } + + /* Exact sizes work, and fill Bc/Br with something a decompress can use. */ + if (smc_compress(result, A->nzval, nzval_len, Br, br_len, Bc, bc_len) != 0) ok = 0; + if (smc_decompress(result, Br, br_len, Bc, bc_len, out, a_len) != 0) ok = 0; + + /* Only understate a length that is positive: `len - 1` on a size_t 0 wraps to + SIZE_MAX, a valid enormous promise that is rightly accepted. A length can + be 0 -- postprocessing can leave zero column groups. */ + if (nzval_len > 0 && + smc_compress(result, A->nzval, nzval_len - 1, Br, br_len, Bc, bc_len) != -3) ok = 0; + if (bc_len > 0 && + smc_compress(result, A->nzval, nzval_len, Br, br_len, Bc, bc_len - 1) != -3) ok = 0; + if (smc_compress(result, NULL, nzval_len, Br, br_len, Bc, bc_len) != -3) ok = 0; + if (bidirectional) { + if (br_len > 0 && + smc_compress(result, A->nzval, nzval_len, Br, br_len - 1, Bc, bc_len) != -3) ok = 0; + /* Both compressed matrices are required. */ + if (smc_compress(result, A->nzval, nzval_len, NULL, 0, Bc, bc_len) != -3) ok = 0; + } else { + /* Br is unused: NULL with a length of 0 is the documented call. */ + if (smc_compress(result, A->nzval, nzval_len, NULL, 0, Bc, bc_len) != 0) ok = 0; + } + + for (k = 0; k < a_len; k++) out[k] = -987.0; + if (a_len > 0 && + smc_decompress(result, Br, br_len, Bc, bc_len, out, a_len - 1) != -3) ok = 0; + if (bc_len > 0 && + smc_decompress(result, Br, br_len, Bc, bc_len - 1, out, a_len) != -3) ok = 0; + if (bidirectional && br_len > 0 && + smc_decompress(result, Br, br_len - 1, Bc, bc_len, out, a_len) != -3) + ok = 0; + if (bidirectional && smc_decompress(result, NULL, 0, Bc, bc_len, out, a_len) != -3) ok = 0; + if (smc_decompress(result, Br, br_len, Bc, bc_len, NULL, a_len) != -3) ok = 0; + for (k = 0; k < a_len; k++) if (out[k] != -987.0) ok = 0; + + if (smc_decompress(result, Br, br_len, Bc, bc_len, out, a_len) != 0) ok = 0; + + free(Br); free(Bc); free(out); + return ok; +} + +static void test_case(const Matrix *A, SmcColoringOptions o, const char *label) +{ + void *result = NULL; + int rows[MAXDIM] = { 0 }, columns[MAXDIM] = { 0 }; + int ncolors = 0, nrow_groups = 0, ncolumn_groups = 0; + int has_columns = (o.partition != SMC_ROW); + int has_rows = (o.partition != SMC_COLUMN); + int direct = (o.decompression == SMC_DIRECT); + double dense[MAXDIM * MAXDIM]; + + if (smc_coloring(A->m, A->n, A->colptr, A->rowval, &o, &result) != 0) { + n_fail++; + printf(" FAIL smc_coloring failed for %s / %s\n", A->name, label); + return; + } + + to_dense(A, dense); + CHECK(smc_ncolors(result, &ncolors) == 0 && ncolors > 0, "ncolors is positive"); + + if (has_columns) { + CHECK(smc_column_colors(result, columns, A->n) == 0, "column colors"); + CHECK(smc_ncolumn_groups(result, &ncolumn_groups) == 0, "ncolumn_groups"); + CHECK(groups_match_colors(result, ncolumn_groups, columns, A->n, o.index_base, 1), + "column groups are exactly the color classes"); + } + if (has_rows) { + CHECK(smc_row_colors(result, rows, A->m) == 0, "row colors"); + CHECK(smc_nrow_groups(result, &nrow_groups) == 0, "nrow_groups"); + CHECK(groups_match_colors(result, nrow_groups, rows, A->m, o.index_base, 0), + "row groups are exactly the color classes"); + } + + if (o.partition == SMC_BIDIRECTIONAL) + CHECK(ncolors == nrow_groups + ncolumn_groups, "ncolors counts both dimensions"); + else if (has_columns) + CHECK(ncolors == ncolumn_groups, "ncolors is the number of column groups"); + else + CHECK(ncolors == nrow_groups, "ncolors is the number of row groups"); + + /* ---- structural validity, from the pattern alone ---------------------- */ + if (o.structure == SMC_NONSYMMETRIC && o.partition == SMC_COLUMN) { + CHECK(column_colors_are_disjoint(dense, A->m, A->n, columns), + "columns of one color share no nonzero row"); + CHECK(is_directly_recoverable(dense, A->m, A->n, NULL, columns), + "every nonzero is recoverable from its column group"); + } else if (o.structure == SMC_NONSYMMETRIC && o.partition == SMC_ROW) { + CHECK(row_colors_are_disjoint(dense, A->m, A->n, rows), + "rows of one color share no nonzero column"); + CHECK(is_directly_recoverable(dense, A->m, A->n, rows, NULL), + "every nonzero is recoverable from its row group"); + } else if (o.structure == SMC_SYMMETRIC) { + CHECK(is_proper(dense, A->n, columns), "the symmetric coloring is proper"); + if (direct) { + CHECK(is_star_coloring(dense, A->n, columns), "the symmetric coloring is a star coloring"); + CHECK(is_symmetrically_recoverable(dense, A->n, columns), + "every nonzero is recoverable, using the symmetry of the matrix"); + } else { + CHECK(is_acyclic_coloring(dense, A->n, columns, ncolors), + "the symmetric coloring is acyclic"); + } + } else if (direct) { /* nonsymmetric bidirectional, direct */ + CHECK(is_directly_recoverable(dense, A->m, A->n, rows, columns), + "every nonzero is recoverable from a row or a column group"); + } + + /* ---- the compressed form determines the matrix ------------------------ */ + if (o.dtype == SMC_FLOAT32) { + CHECK(roundtrip_f32(result, A, direct), "Float32 compress -> decompress round trip"); + } else { + CHECK(roundtrip_f64(result, A, direct), "Float64 compress -> decompress round trip"); + /* The length checks count elements, so one Float64 pass covers them. */ + CHECK(length_guards_ok(result, A), "every buffer length is checked, and short is -3"); + } + + CHECK(smc_result_free(result) == 0, "free"); +} + +static void test_fast_coloring(const Matrix *A, SmcColoringOptions o) +{ + void *result = NULL; + int rows[MAXDIM], columns[MAXDIM]; + int frows[MAXDIM], fcolumns[MAXDIM]; + int ncolors = 0, fncolors = -1, k, same = 1; + + if (smc_coloring(A->m, A->n, A->colptr, A->rowval, &o, &result) != 0) { + n_fail++; + printf(" FAIL smc_coloring failed in the fast_coloring comparison\n"); + return; + } + smc_ncolors(result, &ncolors); + if (o.partition != SMC_ROW) smc_column_colors(result, columns, A->n); + if (o.partition != SMC_COLUMN) smc_row_colors(result, rows, A->m); + smc_result_free(result); + + CHECK(smc_fast_coloring(A->m, A->n, A->colptr, A->rowval, &o, + frows, fcolumns, &fncolors) == 0, "smc_fast_coloring succeeds"); + CHECK(fncolors == ncolors, "smc_fast_coloring reports the same number of colors"); + if (o.partition != SMC_ROW) + for (k = 0; k < A->n; k++) if (fcolumns[k] != columns[k]) same = 0; + if (o.partition != SMC_COLUMN) + for (k = 0; k < A->m; k++) if (frows[k] != rows[k]) same = 0; + CHECK(same, "smc_fast_coloring agrees with smc_coloring"); + + /* A buffer may be NULL exactly when the partition produces no coloring for + that dimension. */ + fncolors = -1; + CHECK(smc_fast_coloring(A->m, A->n, A->colptr, A->rowval, &o, NULL, fcolumns, &fncolors) == + (o.partition == SMC_COLUMN ? 0 : -3), "NULL row_colors"); + fncolors = -1; + CHECK(smc_fast_coloring(A->m, A->n, A->colptr, A->rowval, &o, frows, NULL, &fncolors) == + (o.partition == SMC_ROW ? 0 : -3), "NULL column_colors"); +} + +static const int SUPPORTED[6][3] = { + { SMC_NONSYMMETRIC, SMC_COLUMN, SMC_DIRECT }, + { SMC_NONSYMMETRIC, SMC_ROW, SMC_DIRECT }, + { SMC_SYMMETRIC, SMC_COLUMN, SMC_DIRECT }, + { SMC_SYMMETRIC, SMC_COLUMN, SMC_SUBSTITUTION }, + { SMC_NONSYMMETRIC, SMC_BIDIRECTIONAL, SMC_DIRECT }, + { SMC_NONSYMMETRIC, SMC_BIDIRECTIONAL, SMC_SUBSTITUTION } +}; + +static const char *STRUCTURE_NAME[2] = { "nonsymmetric", "symmetric" }; +static const char *PARTITION_NAME[3] = { "column", "row", "bidirectional" }; +static const char *DECOMPRESSION_NAME[2] = { "direct", "substitution" }; +static const char *ORDER_NAME[5] = { "natural", "largest_first", "smallest_last", + "incidence_degree", "dynamic_largest_first" }; + +static void test_all_combinations(void) +{ + int c, order, post, dt, k; + char label[128]; + + for (c = 0; c < 6; c++) { + const Matrix *matrices = (SUPPORTED[c][0] == SMC_SYMMETRIC) ? SYM_MATRICES : NONSYM_MATRICES; + printf("%s / %s / %s ...\n", STRUCTURE_NAME[SUPPORTED[c][0]], + PARTITION_NAME[SUPPORTED[c][1]], DECOMPRESSION_NAME[SUPPORTED[c][2]]); + for (order = 0; order < 5; order++) + for (post = 0; post < 2; post++) + for (dt = 0; dt < 2; dt++) + for (k = 0; k < 2; k++) { + SmcColoringOptions o = smc_default_options(); + o.structure = SUPPORTED[c][0]; + o.partition = SUPPORTED[c][1]; + o.decompression = SUPPORTED[c][2]; + o.order = order; + o.postprocessing = post; + o.dtype = dt; + snprintf(label, sizeof(label), "order=%s postprocessing=%d dtype=%d", + ORDER_NAME[order], post, dt); + test_case(&matrices[k], o, label); + } + /* fast_coloring only needs one pass per combination. */ + for (k = 0; k < 2; k++) { + SmcColoringOptions o = smc_default_options(); + o.structure = SUPPORTED[c][0]; + o.partition = SUPPORTED[c][1]; + o.decompression = SUPPORTED[c][2]; + o.order = SMC_LARGEST_FIRST; + test_fast_coloring(&matrices[k], o); + } + } +} + +/* index_base shifts the pattern indices, never the colors. */ +static void test_index_base(void) +{ + int c, k; + + printf("index_base 0 vs 1 ...\n"); + for (c = 0; c < 6; c++) { + const Matrix *matrices = (SUPPORTED[c][0] == SMC_SYMMETRIC) ? SYM_MATRICES : NONSYM_MATRICES; + for (k = 0; k < 2; k++) { + const Matrix *A = &matrices[k]; + SmcColoringOptions o0 = smc_default_options(); + SmcColoringOptions o1 = smc_default_options(); + void *r0 = NULL, *r1 = NULL; + int colptr1[MAXDIM + 1], rowval1[MAXNNZ], j, same = 1; + int c0[MAXDIM], c1[MAXDIM], nc0 = 0, nc1 = 0; + + o0.structure = o1.structure = SUPPORTED[c][0]; + o0.partition = o1.partition = SUPPORTED[c][1]; + o0.decompression = o1.decompression = SUPPORTED[c][2]; + o1.index_base = 1; + + for (j = 0; j <= A->n; j++) colptr1[j] = A->colptr[j] + 1; + for (j = 0; j < A->colptr[A->n]; j++) rowval1[j] = A->rowval[j] + 1; + + CHECK(smc_coloring(A->m, A->n, A->colptr, A->rowval, &o0, &r0) == 0, "0-based coloring"); + CHECK(smc_coloring(A->m, A->n, colptr1, rowval1, &o1, &r1) == 0, "1-based coloring"); + smc_ncolors(r0, &nc0); + smc_ncolors(r1, &nc1); + CHECK(nc0 == nc1, "index_base does not change the number of colors"); + + if (o0.partition != SMC_ROW) { + smc_column_colors(r0, c0, A->n); + smc_column_colors(r1, c1, A->n); + for (j = 0; j < A->n; j++) if (c0[j] != c1[j]) same = 0; + } + if (o0.partition != SMC_COLUMN) { + smc_row_colors(r0, c0, A->m); + smc_row_colors(r1, c1, A->m); + for (j = 0; j < A->m; j++) if (c0[j] != c1[j]) same = 0; + } + CHECK(same, "index_base does not change the colors"); + + smc_result_free(r0); + smc_result_free(r1); + } + } +} + +/* postprocessing may only replace colors by the neutral color 0, never make the + coloring worse. */ +static void test_postprocessing(void) +{ + int k; + + printf("postprocessing ...\n"); + for (k = 0; k < 2; k++) { + const Matrix *A = &SYM_MATRICES[k]; + SmcColoringOptions off = smc_default_options(); + SmcColoringOptions on = smc_default_options(); + void *r_off = NULL, *r_on = NULL; + int c_off[MAXDIM], c_on[MAXDIM], nc_off = 0, nc_on = 0, j, l, valid = 1, injective = 1; + + off.structure = on.structure = SMC_SYMMETRIC; + on.postprocessing = 1; + + CHECK(smc_coloring(A->m, A->n, A->colptr, A->rowval, &off, &r_off) == 0, "coloring"); + CHECK(smc_coloring(A->m, A->n, A->colptr, A->rowval, &on, &r_on) == 0, "coloring (postprocessed)"); + smc_ncolors(r_off, &nc_off); + smc_ncolors(r_on, &nc_on); + smc_column_colors(r_off, c_off, A->n); + smc_column_colors(r_on, c_on, A->n); + + CHECK(nc_on <= nc_off, "postprocessing never increases the number of colors"); + for (j = 0; j < A->n; j++) { + if (c_on[j] < 0 || c_on[j] > nc_on) valid = 0; + if (c_off[j] < 1 || c_off[j] > nc_off) valid = 0; + } + CHECK(valid, "colors stay within 0..ncolors, and are nonzero without postprocessing"); + + /* Surviving colors are renamed injectively: two vertices keep the same + nonzero color together. */ + for (j = 0; j < A->n; j++) + for (l = j + 1; l < A->n; l++) { + if (c_on[j] == 0 || c_on[l] == 0) continue; + if ((c_on[j] == c_on[l]) != (c_off[j] == c_off[l])) injective = 0; + } + CHECK(injective, "postprocessing renames colors injectively"); + + smc_result_free(r_off); + smc_result_free(r_on); + } +} + +int main(void) +{ + test_all_combinations(); + test_index_base(); + test_postprocessing(); + + printf("\n%d checks passed, %d failed\n", n_pass, n_fail); + return n_fail > 0 ? 1 : 0; +} diff --git a/interfaces/test/Fortran/test_smc.f90 b/interfaces/test/Fortran/test_smc.f90 new file mode 100644 index 00000000..33872a6f --- /dev/null +++ b/interfaces/test/Fortran/test_smc.f90 @@ -0,0 +1,1621 @@ +! test_smc.f90 - tests for the Fortran binding of libsmc (interfaces/include/smc.f90). +! +! The Fortran counterpart of interfaces/test/C/test_api.c and test_coloring.c: +! the same contract through the Fortran binding, so that a drift between smc.h +! and smc.f90 is caught here rather than as silent memory corruption. +! +! Four Fortran-specific rules this file follows: +! 1. anything whose address is taken with c_loc carries the target attribute; +! 2. a buffer length may legitimately be 0, and integer(c_size_t) is signed in +! Fortran, so 0 - 1 reaches C as SIZE_MAX (a valid, enormous promise): +! never understate a length without first checking that it is positive; +! 3. a result is bidirectional when Br_cols > 0, never when Br_len > 0, which +! can be 0 for a bidirectional result whose row coloring is empty; +! 4. trim() is never applied to a character array element -- that form kills +! the process under MinGW. Copy into a scalar and use X(1:len_trim(X)). +! +! Compile (after building libsmc with juliac - see interfaces/README.md): +! gfortran -O2 -o interfaces/build/test_smc_fortran \ +! interfaces/test/Fortran/test_smc.f90 \ +! -I interfaces/include \ +! interfaces/build/lib/libsmc.so +! +! Exit code: 0 if all checks pass, 1 otherwise. + +program test_smc + use iso_c_binding + use iso_fortran_env, only: output_unit + implicit none + include 'smc.f90' ! must come after implicit none + + ! Harness state and problem data, visible to the contained procedures by host + ! association. + + integer, parameter :: MAXDIM = 12 + integer, parameter :: MAXNNZ = 64 + + ! A sparsity pattern with values, in CSC form. The arrays are oversized so + ! that one fixed-size type holds every test matrix; only the first n+1 and nnz + ! entries are ever passed on. + type :: TestMatrix + character(len=24) :: name + integer(c_int) :: m, n, nnz + integer(c_int) :: colptr(MAXDIM+1) + integer(c_int) :: rowval(MAXNNZ) + real(c_double) :: nzval(MAXNNZ) + end type TestMatrix + + ! target, because c_loc is taken of their colptr / rowval components. + type(TestMatrix), target :: NONSYM(2), SYMM(2) ! index_base 0 + type(TestMatrix), target :: NONSYM1(2), SYMM1(2) ! the same, index_base 1 + + ! The six supported triples, one per column (Fortran is column-major). + integer(c_int), parameter :: SUPPORTED(3,6) = reshape( [ & + SMC_NONSYMMETRIC, SMC_COLUMN, SMC_DIRECT, & + SMC_NONSYMMETRIC, SMC_ROW, SMC_DIRECT, & + SMC_SYMMETRIC, SMC_COLUMN, SMC_DIRECT, & + SMC_SYMMETRIC, SMC_COLUMN, SMC_SUBSTITUTION, & + SMC_NONSYMMETRIC, SMC_BIDIRECTIONAL, SMC_DIRECT, & + SMC_NONSYMMETRIC, SMC_BIDIRECTIONAL, SMC_SUBSTITUTION ], [3,6] ) + + ! The six triples that are not a SparseMatrixColorings problem; see smc.f90. + integer(c_int), parameter :: UNSUPPORTED(3,6) = reshape( [ & + SMC_NONSYMMETRIC, SMC_COLUMN, SMC_SUBSTITUTION, & + SMC_NONSYMMETRIC, SMC_ROW, SMC_SUBSTITUTION, & + SMC_SYMMETRIC, SMC_ROW, SMC_DIRECT, & + SMC_SYMMETRIC, SMC_ROW, SMC_SUBSTITUTION, & + SMC_SYMMETRIC, SMC_BIDIRECTIONAL, SMC_DIRECT, & + SMC_SYMMETRIC, SMC_BIDIRECTIONAL, SMC_SUBSTITUTION ], [3,6] ) + + character(len=13), parameter :: STRUCTURE_NAME(0:1) = & + [ character(len=13) :: "nonsymmetric", "symmetric" ] + character(len=13), parameter :: PARTITION_NAME(0:2) = & + [ character(len=13) :: "column", "row", "bidirectional" ] + character(len=12), parameter :: DECOMPRESSION_NAME(0:1) = & + [ character(len=12) :: "direct", "substitution" ] + character(len=21), parameter :: ORDER_NAME(0:4) = & + [ character(len=21) :: "natural", "largest_first", "smallest_last", & + "incidence_degree", "dynamic_largest_first" ] + + ! The value a rejected call must leave in place. + real(c_double), parameter :: SENTINEL = -987.0_c_double + real(c_float), parameter :: SENTINEL32 = -987.0_c_float + + integer :: n_pass = 0 + integer :: n_fail = 0 + character(len=110) :: ctx = "" + logical :: verbose = .false. + character(len=8) :: verbose_env + + call get_environment_variable("SMC_TEST_VERBOSE", verbose_env) + verbose = (len_trim(verbose_env) > 0 .and. trim(verbose_env) /= "0") + + call build_matrices() + + call test_version() + call test_default_options() + call test_null_options() + call test_unsupported_combinations() + call test_invalid_arguments() + call test_invalid_handle() + call test_sizing_queries() + call test_all_combinations() + call test_index_base() + call test_postprocessing() + + write(*,*) + write(*,'(I0,A,I0,A)') n_pass, " checks passed, ", n_fail, " failed" + if (n_fail > 0) stop 1 + +contains + + ! Set SMC_TEST_VERBOSE=1 to echo every check as it is reached: a crash inside + ! the library kills the process without a FAIL line, and then the last line + ! printed is the last check that completed. + subroutine check(cond, msg) + logical, intent(in) :: cond + character(len=*), intent(in) :: msg + if (verbose) then + if (len_trim(ctx) > 0) then + write(*,'(A,A,A,A,A)') " .. ", trim(msg), " [", trim(ctx), "]" + else + write(*,'(A,A)') " .. ", trim(msg) + end if + flush(output_unit) + end if + if (cond) then + n_pass = n_pass + 1 + else + n_fail = n_fail + 1 + if (len_trim(ctx) > 0) then + write(*,'(A,A,A,A,A)') " FAIL ", trim(msg), " [", trim(ctx), "]" + else + write(*,'(A,A)') " FAIL ", trim(msg) + end if + end if + end subroutine check + + ! Test matrices: the same patterns as interfaces/test/C/test_coloring.c. + + subroutine set_matrix(A, name, m, n, colptr, rowval, nzval) + type(TestMatrix), intent(out) :: A + character(len=*), intent(in) :: name + integer(c_int), intent(in) :: m, n + integer(c_int), intent(in) :: colptr(:), rowval(:) + real(c_double), intent(in) :: nzval(:) + + A%name = name + A%m = m + A%n = n + A%nnz = colptr(n+1) ! 0-based colptr, so colptr(n+1) is the count + A%colptr = 0 + A%rowval = 0 + A%nzval = 0.0_c_double + A%colptr(1:n+1) = colptr(1:n+1) + A%rowval(1:A%nnz) = rowval(1:A%nnz) + A%nzval(1:A%nnz) = nzval(1:A%nnz) + end subroutine set_matrix + + ! The same pattern with every index shifted to base 1. + subroutine shift_matrix(A, B) + type(TestMatrix), intent(in) :: A + type(TestMatrix), intent(out) :: B + B = A + B%colptr(1:A%n+1) = A%colptr(1:A%n+1) + 1 + B%rowval(1:A%nnz) = A%rowval(1:A%nnz) + 1 + end subroutine shift_matrix + + subroutine build_matrices() + integer :: k + + ! 4x6 rectangular, nonsymmetric (the `compress` docstring matrix): + ! . . 4 6 . 9 + ! 1 . . . 7 . + ! . 2 . . 8 . + ! . 3 5 . . . + call set_matrix(NONSYM(1), "nonsym 4x6", 4, 6, & + [ 0, 1, 3, 5, 6, 8, 9 ], & + [ 1, 2, 3, 0, 3, 0, 1, 2, 0 ], & + real([ 1, 2, 3, 4, 5, 6, 7, 8, 9 ], c_double)) + + ! 7x5 rectangular with denser rows and columns. + call set_matrix(NONSYM(2), "nonsym 7x5", 7, 5, & + [ 0, 4, 7, 10, 13, 16 ], & + [ 0, 1, 4, 6, & + 1, 2, 5, & + 2, 3, 6, & + 0, 3, 4, & + 1, 4, 5 ], & + real([ 1, 3, 2, 7, & + 4, 6, 5, & + 7, 8, 8, & + 2, 9, 3, & + 5, 4, 6 ], c_double)) + + ! 7x7 symmetric with a nonzero diagonal: tridiagonal plus the (1,7) corner. + call set_matrix(SYMM(1), "sym 7x7 full diag", 7, 7, & + [ 0, 3, 6, 9, 12, 15, 18, 21 ], & + [ 0, 1, 6, & + 0, 1, 2, & + 1, 2, 3, & + 2, 3, 4, & + 3, 4, 5, & + 4, 5, 6, & + 0, 5, 6 ], & + real([ 2, 1, 3, & + 1, 2, 1, & + 1, 2, 1, & + 1, 2, 1, & + 1, 2, 1, & + 1, 2, 1, & + 3, 1, 2 ], c_double)) + + ! 6x6 symmetric with a zero diagonal (the 3-cube minus a perfect matching); + ! a zero diagonal is what lets postprocessing hand out the neutral color 0. + call set_matrix(SYMM(2), "sym 6x6 zero diag", 6, 6, & + [ 0, 2, 4, 6, 8, 10, 12 ], & + [ 1, 2, & + 0, 3, & + 0, 4, & + 1, 5, & + 2, 5, & + 3, 4 ], & + real([ 1, 2, & + 1, 3, & + 2, 4, & + 3, 5, & + 4, 6, & + 5, 6 ], c_double)) + + do k = 1, 2 + call shift_matrix(NONSYM(k), NONSYM1(k)) + call shift_matrix(SYMM(k), SYMM1(k)) + end do + end subroutine build_matrices + + ! Column j of a base-0 pattern occupies the Fortran positions + ! colptr(j)+1 .. colptr(j+1), and rowval(k)+1 is its Fortran row index. + subroutine build_nz(A, nz) + type(TestMatrix), intent(in) :: A + logical, intent(out) :: nz(MAXDIM,MAXDIM) + integer :: i, j, k + nz = .false. + do j = 1, A%n + do k = A%colptr(j) + 1, A%colptr(j+1) + i = A%rowval(k) + 1 + nz(i,j) = .true. + end do + end do + end subroutine build_nz + + subroutine build_dense(A, dense) + type(TestMatrix), intent(in) :: A + real(c_double), intent(out) :: dense(MAXDIM,MAXDIM) + integer :: i, j, k + dense = 0.0_c_double + do j = 1, A%n + do k = A%colptr(j) + 1, A%colptr(j+1) + i = A%rowval(k) + 1 + dense(i,j) = A%nzval(k) + end do + end do + end subroutine build_dense + + ! Two columns of the same nonzero color must have disjoint row supports. + logical function column_colors_disjoint(nz, m, n, colors) + logical, intent(in) :: nz(MAXDIM,MAXDIM) + integer(c_int), intent(in) :: m, n + integer(c_int), intent(in) :: colors(MAXDIM) + integer :: i, j, k + column_colors_disjoint = .true. + do j = 1, n + do k = j + 1, n + if (colors(j) == 0 .or. colors(k) == 0) cycle + if (colors(j) /= colors(k)) cycle + do i = 1, m + if (nz(i,j) .and. nz(i,k)) then + column_colors_disjoint = .false. + return + end if + end do + end do + end do + end function column_colors_disjoint + + ! The same statement transposed. + logical function row_colors_disjoint(nz, m, n, colors) + logical, intent(in) :: nz(MAXDIM,MAXDIM) + integer(c_int), intent(in) :: m, n + integer(c_int), intent(in) :: colors(MAXDIM) + integer :: i, j, k + row_colors_disjoint = .true. + do i = 1, m + do k = i + 1, m + if (colors(i) == 0 .or. colors(k) == 0) cycle + if (colors(i) /= colors(k)) cycle + do j = 1, n + if (nz(i,j) .and. nz(k,j)) then + row_colors_disjoint = .false. + return + end if + end do + end do + end do + end function row_colors_disjoint + + ! Every nonzero must be readable off the compressed matrix: A(i,j) is either + ! the only nonzero of row i among the columns of its color, or the only + ! nonzero of column j among the rows of its color. + logical function directly_recoverable(nz, m, n, rows, cols, use_rows, use_cols) + logical, intent(in) :: nz(MAXDIM,MAXDIM) + integer(c_int), intent(in) :: m, n + integer(c_int), intent(in) :: rows(MAXDIM), cols(MAXDIM) + logical, intent(in) :: use_rows, use_cols + integer :: i, j, k + logical :: by_column, by_row + directly_recoverable = .true. + do j = 1, n + do i = 1, m + if (.not. nz(i,j)) cycle + by_column = .false. + by_row = .false. + if (use_cols) then + if (cols(j) /= 0) then + by_column = .true. + do k = 1, n + if (k /= j .and. nz(i,k) .and. cols(k) == cols(j)) by_column = .false. + end do + end if + end if + if (use_rows) then + if (rows(i) /= 0) then + by_row = .true. + do k = 1, m + if (k /= i .and. nz(k,j) .and. rows(k) == rows(i)) by_row = .false. + end do + end if + end if + if (.not. by_column .and. .not. by_row) then + directly_recoverable = .false. + return + end if + end do + end do + end function directly_recoverable + + ! Adjacent vertices carry different nonzero colors. + logical function is_proper(nz, n, colors) + logical, intent(in) :: nz(MAXDIM,MAXDIM) + integer(c_int), intent(in) :: n + integer(c_int), intent(in) :: colors(MAXDIM) + integer :: i, j + is_proper = .true. + do j = 1, n + do i = 1, j - 1 + if (.not. nz(i,j)) cycle + if (colors(i) == 0 .or. colors(j) == 0) cycle + if (colors(i) == colors(j)) then + is_proper = .false. + return + end if + end do + end do + end function is_proper + + ! No path i - j - k - l uses only two colors (a star coloring). + logical function is_star_coloring(nz, n, colors) + logical, intent(in) :: nz(MAXDIM,MAXDIM) + integer(c_int), intent(in) :: n + integer(c_int), intent(in) :: colors(MAXDIM) + integer :: i, j, k, l + is_star_coloring = .true. + do j = 1, n + do k = 1, n + if (j == k) cycle + if (.not. nz(j,k)) cycle + do i = 1, n + if (i == j .or. i == k) cycle + if (.not. nz(i,j)) cycle + do l = 1, n + if (l == i .or. l == j .or. l == k) cycle + if (.not. nz(k,l)) cycle + if (colors(i) == 0 .or. colors(j) == 0) cycle + if (colors(k) == 0 .or. colors(l) == 0) cycle + if (colors(i) == colors(k) .and. colors(j) == colors(l)) then + is_star_coloring = .false. + return + end if + end do + end do + end do + end do + end function is_star_coloring + + integer function uf_find(parent, x) + integer, intent(inout) :: parent(MAXDIM) + integer, intent(in) :: x + integer :: r + r = x + do while (parent(r) /= r) + parent(r) = parent(parent(r)) + r = parent(r) + end do + uf_find = r + end function uf_find + + ! Every subgraph induced by two colors is a forest (an acyclic coloring). + logical function is_acyclic_coloring(nz, n, colors, ncolors) + logical, intent(in) :: nz(MAXDIM,MAXDIM) + integer(c_int), intent(in) :: n + integer(c_int), intent(in) :: colors(MAXDIM) + integer(c_int), intent(in) :: ncolors + integer :: ca, cb, i, j, ri, rj, parent(MAXDIM) + is_acyclic_coloring = .true. + do ca = 1, ncolors + do cb = ca + 1, ncolors + do i = 1, MAXDIM + parent(i) = i + end do + do j = 1, n + do i = 1, j - 1 + if (.not. nz(i,j)) cycle + if (.not. ((colors(i) == ca .and. colors(j) == cb) .or. & + (colors(i) == cb .and. colors(j) == ca))) cycle + ri = uf_find(parent, i) + rj = uf_find(parent, j) + if (ri == rj) then ! a cycle inside {ca, cb} + is_acyclic_coloring = .false. + return + end if + parent(ri) = rj + end do + end do + end do + end do + end function is_acyclic_coloring + + ! Symmetric counterpart: A(i,j) is read from B(i, colors(j)) when column j is + ! the only one of its color meeting row i, or - by symmetry - B(j, colors(i)). + logical function symmetrically_recoverable(nz, n, colors) + logical, intent(in) :: nz(MAXDIM,MAXDIM) + integer(c_int), intent(in) :: n + integer(c_int), intent(in) :: colors(MAXDIM) + integer :: i, j, k + logical :: by_j, by_i + symmetrically_recoverable = .true. + do j = 1, n + do i = 1, n + if (.not. nz(i,j)) cycle + by_j = .false. + by_i = .false. + if (colors(j) /= 0) then + by_j = .true. + do k = 1, n + if (k /= j .and. nz(i,k) .and. colors(k) == colors(j)) by_j = .false. + end do + end if + if (colors(i) /= 0) then + by_i = .true. + do k = 1, n + if (k /= i .and. nz(j,k) .and. colors(k) == colors(i)) by_i = .false. + end do + end if + if (.not. by_j .and. .not. by_i) then + symmetrically_recoverable = .false. + return + end if + end do + end do + end function symmetrically_recoverable + + integer(c_int) function color_matrix(A, o, result) + type(TestMatrix), target, intent(in) :: A + type(SmcColoringOptions), target, intent(in) :: o + type(c_ptr), intent(out) :: result + color_matrix = smc_coloring(A%m, A%n, c_loc(A%colptr), c_loc(A%rowval), & + c_loc(o), result) + end function color_matrix + + ! The groups are exactly the color classes. + logical function groups_match_colors(result, ngroups, colors, len, base, column) + type(c_ptr), intent(in) :: result + integer(c_int), intent(in) :: ngroups + integer(c_int), intent(in) :: colors(MAXDIM) + integer(c_int), intent(in) :: len, base + logical, intent(in) :: column + + integer(c_int), target :: members(MAXDIM), gsize + integer(c_int) :: ret + integer :: g, k, index + logical :: seen(MAXDIM) + + groups_match_colors = .true. + seen = .false. + + do g = 1, ngroups + gsize = -1 + if (column) then + ret = smc_column_group_size(result, int(g, c_int), c_loc(gsize)) + else + ret = smc_row_group_size(result, int(g, c_int), c_loc(gsize)) + end if + if (ret /= 0 .or. gsize < 0 .or. gsize > len) then + groups_match_colors = .false. + return + end if + if (column) then + ret = smc_column_group(result, int(g, c_int), c_loc(members), gsize) + else + ret = smc_row_group(result, int(g, c_int), c_loc(members), gsize) + end if + if (ret /= 0) then + groups_match_colors = .false. + return + end if + do k = 1, gsize + ! members are in the caller's index base; make them Fortran indices. + index = members(k) - base + 1 + if (index < 1 .or. index > len) then + groups_match_colors = .false. + return + end if + if (seen(index)) then ! a member of two groups + groups_match_colors = .false. + return + end if + seen(index) = .true. + if (colors(index) /= g) then ! wrong group + groups_match_colors = .false. + return + end if + end do + end do + + ! Every non-neutral index belongs to exactly one group, and only those. + do k = 1, len + if (colors(k) /= 0 .and. .not. seen(k)) groups_match_colors = .false. + if (colors(k) == 0 .and. seen(k)) groups_match_colors = .false. + if (colors(k) < 0 .or. colors(k) > ngroups) groups_match_colors = .false. + end do + end function groups_match_colors + + ! The buffer lengths, read back from the API rather than from TestMatrix, + ! which also checks that smc_nnz and smc_size agree with the colored pattern. + ! ok is .false. if any query fails or disagrees. + subroutine query_lengths(result, A, Br_rows, Br_cols, Bc_rows, Bc_cols, & + br_len, bc_len, a_len, nz_len, ok) + type(c_ptr), intent(in) :: result + type(TestMatrix), intent(in) :: A + integer(c_int), intent(out) :: Br_rows, Br_cols, Bc_rows, Bc_cols + integer(c_size_t), intent(out) :: br_len, bc_len, a_len, nz_len + logical, intent(out) :: ok + + integer(c_int), target :: brr, brc, bcr, bcc, nnz_q, m_q, n_q + integer(c_int) :: ret + + Br_rows = 0; Br_cols = 0; Bc_rows = 0; Bc_cols = 0 + br_len = 0; bc_len = 0; a_len = 0; nz_len = 0 + ok = .false. + + brr = -1; brc = -1; bcr = -1; bcc = -1 + ret = smc_compressed_size(result, c_loc(brr), c_loc(brc), c_loc(bcr), c_loc(bcc)) + if (ret /= 0) return + + nnz_q = -1 + ret = smc_nnz(result, c_loc(nnz_q)) + if (ret /= 0 .or. nnz_q /= A%nnz) return + + m_q = -1; n_q = -1 + ret = smc_size(result, c_loc(m_q), c_loc(n_q)) + if (ret /= 0 .or. m_q /= A%m .or. n_q /= A%n) return + + Br_rows = brr; Br_cols = brc; Bc_rows = bcr; Bc_cols = bcc + br_len = int(brr, c_size_t) * int(brc, c_size_t) + bc_len = int(bcr, c_size_t) * int(bcc, c_size_t) + a_len = int(m_q, c_size_t) * int(n_q, c_size_t) + nz_len = int(nnz_q, c_size_t) + ok = .true. + end subroutine query_lengths + + logical function roundtrip_f64(result, A, exact) + type(c_ptr), intent(in) :: result + type(TestMatrix), target, intent(in) :: A + logical, intent(in) :: exact + + integer(c_int) :: Br_rows, Br_cols, Bc_rows, Bc_cols, ret + integer(c_size_t) :: br_len, bc_len, a_len, nz_len + logical :: ok, bidir + real(c_double), target, allocatable :: Br(:), Bc(:), out(:) + real(c_double) :: dense(MAXDIM,MAXDIM), expected, got + type(c_ptr) :: Br_ptr + integer :: i, j + + call query_lengths(result, A, Br_rows, Br_cols, Bc_rows, Bc_cols, & + br_len, bc_len, a_len, nz_len, ok) + roundtrip_f64 = ok + if (.not. ok) return + + ! Br_cols identifies the partition; br_len does not (it can be 0 for a + ! bidirectional result whose row coloring was emptied by postprocessing). + bidir = (Br_cols > 0) + + ! c_loc needs a nonzero-sized object, so never allocate 0 elements. + allocate(Br(max(br_len, 1_c_size_t))) + allocate(Bc(max(bc_len, 1_c_size_t))) + allocate(out(max(a_len, 1_c_size_t))) + Br = SENTINEL + Bc = SENTINEL + out = SENTINEL + + if (bidir) then + Br_ptr = c_loc(Br) + else + Br_ptr = c_null_ptr ! the documented call for the other partitions + end if + + ret = smc_compress(result, c_loc(A%nzval), nz_len, Br_ptr, br_len, c_loc(Bc), bc_len) + if (ret /= 0) roundtrip_f64 = .false. + ret = smc_decompress(result, Br_ptr, br_len, c_loc(Bc), bc_len, c_loc(out), a_len) + if (ret /= 0) roundtrip_f64 = .false. + + if (roundtrip_f64) then + call build_dense(A, dense) + do j = 1, A%n + do i = 1, A%m + expected = dense(i,j) + got = out((j-1)*A%m + i) + if (exact) then + if (got /= expected) roundtrip_f64 = .false. + else + if (abs(got - expected) > 1.0e-9_c_double * (1.0_c_double + abs(expected))) & + roundtrip_f64 = .false. + end if + end do + end do + end if + + deallocate(Br, Bc, out) + end function roundtrip_f64 + + logical function roundtrip_f32(result, A, exact) + type(c_ptr), intent(in) :: result + type(TestMatrix), intent(in) :: A + logical, intent(in) :: exact + + integer(c_int) :: Br_rows, Br_cols, Bc_rows, Bc_cols, ret + integer(c_size_t) :: br_len, bc_len, a_len, nz_len + logical :: ok, bidir + real(c_float), target, allocatable :: Br(:), Bc(:), out(:) + real(c_float), target :: nz32(MAXNNZ) + real(c_double) :: dense(MAXDIM,MAXDIM) + real(c_float) :: expected, got + type(c_ptr) :: Br_ptr + integer :: i, j + + call query_lengths(result, A, Br_rows, Br_cols, Bc_rows, Bc_cols, & + br_len, bc_len, a_len, nz_len, ok) + roundtrip_f32 = ok + if (.not. ok) return + + bidir = (Br_cols > 0) + + ! Lengths are element counts, so they match the Float64 numbers. + nz32 = 0.0_c_float + nz32(1:A%nnz) = real(A%nzval(1:A%nnz), c_float) + + allocate(Br(max(br_len, 1_c_size_t))) + allocate(Bc(max(bc_len, 1_c_size_t))) + allocate(out(max(a_len, 1_c_size_t))) + Br = SENTINEL32 + Bc = SENTINEL32 + out = SENTINEL32 + + if (bidir) then + Br_ptr = c_loc(Br) + else + Br_ptr = c_null_ptr + end if + + ret = smc_compress(result, c_loc(nz32), nz_len, Br_ptr, br_len, c_loc(Bc), bc_len) + if (ret /= 0) roundtrip_f32 = .false. + ret = smc_decompress(result, Br_ptr, br_len, c_loc(Bc), bc_len, c_loc(out), a_len) + if (ret /= 0) roundtrip_f32 = .false. + + if (roundtrip_f32) then + call build_dense(A, dense) + do j = 1, A%n + do i = 1, A%m + expected = real(dense(i,j), c_float) + got = out((j-1)*A%m + i) + if (exact) then + if (got /= expected) roundtrip_f32 = .false. + else + if (abs(got - expected) > 1.0e-4_c_float * (1.0_c_float + abs(expected))) & + roundtrip_f32 = .false. + end if + end do + end do + end if + + deallocate(Br, Bc, out) + end function roundtrip_f32 + + ! Every buffer length, one element short, one at a time. Each buffer keeps + ! its full size and is pre-filled, so a -3 can only come from the length check + ! and a surviving sentinel proves the check ran before any write. Lengths are + ! only understated when positive; see pitfall 2 in the file header. + logical function length_guards(result, A) + type(c_ptr), intent(in) :: result + type(TestMatrix), target, intent(in) :: A + + integer(c_int) :: Br_rows, Br_cols, Bc_rows, Bc_cols, ret + integer(c_size_t) :: br_len, bc_len, a_len, nz_len + logical :: ok, bidir + real(c_double), target, allocatable :: Br(:), Bc(:), out(:) + type(c_ptr) :: Br_ptr + integer(c_size_t) :: k + + call query_lengths(result, A, Br_rows, Br_cols, Bc_rows, Bc_cols, & + br_len, bc_len, a_len, nz_len, ok) + length_guards = ok + if (.not. ok) return + + bidir = (Br_cols > 0) + + allocate(Br(max(br_len, 1_c_size_t))) + allocate(Bc(max(bc_len, 1_c_size_t))) + allocate(out(max(a_len, 1_c_size_t))) + + if (bidir) then + Br_ptr = c_loc(Br) + else + Br_ptr = c_null_ptr + end if + + ! The exact sizes work, and fill Bc / Br with something decompress can use. + ret = smc_compress(result, c_loc(A%nzval), nz_len, Br_ptr, br_len, c_loc(Bc), bc_len) + if (ret /= 0) length_guards = .false. + ret = smc_decompress(result, Br_ptr, br_len, c_loc(Bc), bc_len, c_loc(out), a_len) + if (ret /= 0) length_guards = .false. + + ! ---- smc_compress ----------------------------------------------------- + if (nz_len > 0) then + ret = smc_compress(result, c_loc(A%nzval), nz_len - 1, Br_ptr, br_len, & + c_loc(Bc), bc_len) + if (ret /= -3) length_guards = .false. + end if + if (bc_len > 0) then + ret = smc_compress(result, c_loc(A%nzval), nz_len, Br_ptr, br_len, & + c_loc(Bc), bc_len - 1) + if (ret /= -3) length_guards = .false. + end if + ret = smc_compress(result, c_null_ptr, nz_len, Br_ptr, br_len, c_loc(Bc), bc_len) + if (ret /= -3) length_guards = .false. + ret = smc_compress(result, c_loc(A%nzval), nz_len, Br_ptr, br_len, c_null_ptr, bc_len) + if (ret /= -3) length_guards = .false. + + if (bidir) then + if (br_len > 0) then + ret = smc_compress(result, c_loc(A%nzval), nz_len, c_loc(Br), br_len - 1, & + c_loc(Bc), bc_len) + if (ret /= -3) length_guards = .false. + end if + ! Both compressed matrices are required. + ret = smc_compress(result, c_loc(A%nzval), nz_len, c_null_ptr, 0_c_size_t, & + c_loc(Bc), bc_len) + if (ret /= -3) length_guards = .false. + else + ! Br is unused: c_null_ptr with a length of 0 is the documented call. + ret = smc_compress(result, c_loc(A%nzval), nz_len, c_null_ptr, 0_c_size_t, & + c_loc(Bc), bc_len) + if (ret /= 0) length_guards = .false. + end if + + ! A generous length is a promise, not an error: the comparison is unsigned + ! on the C side and must not wrap. + ret = smc_compress(result, c_loc(A%nzval), huge(0_c_size_t), Br_ptr, br_len, & + c_loc(Bc), bc_len) + if (ret /= 0) length_guards = .false. + + ret = smc_compress(result, c_loc(A%nzval), nz_len, Br_ptr, br_len, c_loc(Bc), bc_len) + if (ret /= 0) length_guards = .false. + + ! ---- smc_decompress --------------------------------------------------- + out = SENTINEL + if (a_len > 0) then + ret = smc_decompress(result, Br_ptr, br_len, c_loc(Bc), bc_len, c_loc(out), a_len - 1) + if (ret /= -3) length_guards = .false. + end if + if (bc_len > 0) then + ret = smc_decompress(result, Br_ptr, br_len, c_loc(Bc), bc_len - 1, c_loc(out), a_len) + if (ret /= -3) length_guards = .false. + end if + if (bidir .and. br_len > 0) then + ret = smc_decompress(result, c_loc(Br), br_len - 1, c_loc(Bc), bc_len, c_loc(out), a_len) + if (ret /= -3) length_guards = .false. + end if + if (bidir) then + ret = smc_decompress(result, c_null_ptr, 0_c_size_t, c_loc(Bc), bc_len, & + c_loc(out), a_len) + if (ret /= -3) length_guards = .false. + end if + ret = smc_decompress(result, Br_ptr, br_len, c_null_ptr, bc_len, c_loc(out), a_len) + if (ret /= -3) length_guards = .false. + ret = smc_decompress(result, Br_ptr, br_len, c_loc(Bc), bc_len, c_null_ptr, a_len) + if (ret /= -3) length_guards = .false. + + do k = 1, a_len + if (out(k) /= SENTINEL) length_guards = .false. + end do + + ! The exact sizes still work after every rejection. + ret = smc_decompress(result, Br_ptr, br_len, c_loc(Bc), bc_len, c_loc(out), a_len) + if (ret /= 0) length_guards = .false. + + deallocate(Br, Bc, out) + end function length_guards + + subroutine test_case(A, o, label) + type(TestMatrix), target, intent(in) :: A + type(SmcColoringOptions), intent(in) :: o + character(len=*), intent(in) :: label + + type(SmcColoringOptions), target :: opts + type(c_ptr) :: result + integer(c_int), target :: ncolors, ngroups_c, ngroups_r + integer(c_int), target :: colors_c(MAXDIM), colors_r(MAXDIM) + integer(c_int) :: ret + logical :: has_columns, has_rows, direct + logical :: nz(MAXDIM,MAXDIM) + + opts = o + ctx = A%name(1:len_trim(A%name)) // " / " // label(1:len_trim(label)) + + result = c_null_ptr + ret = color_matrix(A, opts, result) + if (ret /= 0) then + call check(.false., "smc_coloring succeeds") + ctx = "" + return + end if + + has_columns = (opts%partition /= SMC_ROW) + has_rows = (opts%partition /= SMC_COLUMN) + direct = (opts%decompression == SMC_DIRECT) + call build_nz(A, nz) + + colors_c = 0 + colors_r = 0 + ncolors = 0 + ngroups_c = 0 + ngroups_r = 0 + + ret = smc_ncolors(result, c_loc(ncolors)) + call check(ret == 0 .and. ncolors > 0, "ncolors is positive") + + if (has_columns) then + ret = smc_column_colors(result, c_loc(colors_c), A%n) + call check(ret == 0, "smc_column_colors succeeds") + ret = smc_ncolumn_groups(result, c_loc(ngroups_c)) + call check(ret == 0, "smc_ncolumn_groups succeeds") + call check(groups_match_colors(result, ngroups_c, colors_c, A%n, & + opts%index_base, .true.), & + "column groups are exactly the color classes") + else + ret = smc_column_colors(result, c_loc(colors_c), A%n) + call check(ret == -2, "a row partition has no column coloring (-2)") + end if + + if (has_rows) then + ret = smc_row_colors(result, c_loc(colors_r), A%m) + call check(ret == 0, "smc_row_colors succeeds") + ret = smc_nrow_groups(result, c_loc(ngroups_r)) + call check(ret == 0, "smc_nrow_groups succeeds") + call check(groups_match_colors(result, ngroups_r, colors_r, A%m, & + opts%index_base, .false.), & + "row groups are exactly the color classes") + else + ret = smc_row_colors(result, c_loc(colors_r), A%m) + call check(ret == -2, "a column partition has no row coloring (-2)") + end if + + if (opts%partition == SMC_BIDIRECTIONAL) then + call check(ncolors == ngroups_r + ngroups_c, "ncolors counts both dimensions") + else if (has_columns) then + call check(ncolors == ngroups_c, "ncolors is the number of column groups") + else + call check(ncolors == ngroups_r, "ncolors is the number of row groups") + end if + + ! ---- structural validity, from the pattern alone ---------------------- + if (opts%structure == SMC_NONSYMMETRIC .and. opts%partition == SMC_COLUMN) then + call check(column_colors_disjoint(nz, A%m, A%n, colors_c), & + "columns of one color share no nonzero row") + call check(directly_recoverable(nz, A%m, A%n, colors_r, colors_c, .false., .true.), & + "every nonzero is recoverable from its column group") + else if (opts%structure == SMC_NONSYMMETRIC .and. opts%partition == SMC_ROW) then + call check(row_colors_disjoint(nz, A%m, A%n, colors_r), & + "rows of one color share no nonzero column") + call check(directly_recoverable(nz, A%m, A%n, colors_r, colors_c, .true., .false.), & + "every nonzero is recoverable from its row group") + else if (opts%structure == SMC_SYMMETRIC) then + call check(is_proper(nz, A%n, colors_c), "the symmetric coloring is proper") + if (direct) then + call check(is_star_coloring(nz, A%n, colors_c), & + "the symmetric coloring is a star coloring") + call check(symmetrically_recoverable(nz, A%n, colors_c), & + "every nonzero is recoverable, using the symmetry of A") + else + call check(is_acyclic_coloring(nz, A%n, colors_c, ncolors), & + "the symmetric coloring is acyclic") + end if + else if (direct) then ! nonsymmetric bidirectional, direct + call check(directly_recoverable(nz, A%m, A%n, colors_r, colors_c, .true., .true.), & + "every nonzero is recoverable from a row or a column group") + end if + + ! ---- the compressed form determines the matrix ------------------------ + if (opts%dtype == SMC_FLOAT32) then + call check(roundtrip_f32(result, A, direct), & + "Float32 compress -> decompress round trip") + else + call check(roundtrip_f64(result, A, direct), & + "Float64 compress -> decompress round trip") + ! The length checks count elements, so one Float64 pass covers them. + call check(length_guards(result, A), & + "every buffer length is checked, and short is -3") + end if + + ret = smc_result_free(result) + call check(ret == 0, "smc_result_free succeeds") + ctx = "" + end subroutine test_case + + subroutine test_fast_coloring(A, o) + type(TestMatrix), target, intent(in) :: A + type(SmcColoringOptions), intent(in) :: o + + type(SmcColoringOptions), target :: opts + type(c_ptr) :: result + integer(c_int), target :: rows(MAXDIM), cols(MAXDIM) + integer(c_int), target :: frows(MAXDIM), fcols(MAXDIM) + integer(c_int), target :: ncolors, fncolors + integer(c_int) :: ret, want + integer :: k + logical :: same + + opts = o + ctx = A%name(1:len_trim(A%name)) // " / fast_coloring" + + rows = 0; cols = 0; frows = 0; fcols = 0 + ncolors = 0 + + result = c_null_ptr + ret = color_matrix(A, opts, result) + if (ret /= 0) then + call check(.false., "smc_coloring succeeds in the fast_coloring comparison") + ctx = "" + return + end if + ret = smc_ncolors(result, c_loc(ncolors)) + if (opts%partition /= SMC_ROW) ret = smc_column_colors(result, c_loc(cols), A%n) + if (opts%partition /= SMC_COLUMN) ret = smc_row_colors(result, c_loc(rows), A%m) + ret = smc_result_free(result) + call check(ret == 0, "free before the fast_coloring comparison") + + fncolors = -1 + ret = smc_fast_coloring(A%m, A%n, c_loc(A%colptr), c_loc(A%rowval), c_loc(opts), & + c_loc(frows), c_loc(fcols), c_loc(fncolors)) + call check(ret == 0, "smc_fast_coloring succeeds") + call check(fncolors == ncolors, "smc_fast_coloring reports the same number of colors") + + same = .true. + if (opts%partition /= SMC_ROW) then + do k = 1, A%n + if (fcols(k) /= cols(k)) same = .false. + end do + end if + if (opts%partition /= SMC_COLUMN) then + do k = 1, A%m + if (frows(k) /= rows(k)) same = .false. + end do + end if + call check(same, "smc_fast_coloring agrees with smc_coloring") + + ! A buffer may be c_null_ptr exactly when the partition produces no coloring + ! for that dimension. + fncolors = -1 + if (opts%partition == SMC_COLUMN) then + want = 0 + else + want = -3 + end if + ret = smc_fast_coloring(A%m, A%n, c_loc(A%colptr), c_loc(A%rowval), c_loc(opts), & + c_null_ptr, c_loc(fcols), c_loc(fncolors)) + call check(ret == want, "c_null_ptr row_colors") + + fncolors = -1 + if (opts%partition == SMC_ROW) then + want = 0 + else + want = -3 + end if + ret = smc_fast_coloring(A%m, A%n, c_loc(A%colptr), c_loc(A%rowval), c_loc(opts), & + c_loc(frows), c_null_ptr, c_loc(fncolors)) + call check(ret == want, "c_null_ptr column_colors") + ctx = "" + end subroutine test_fast_coloring + + subroutine test_all_combinations() + integer :: c, order, post, dt, k + type(SmcColoringOptions) :: o + character(len=80) :: label + character(len=13) :: sname, pname + character(len=12) :: dname + character(len=21) :: oname + + do c = 1, 6 + sname = STRUCTURE_NAME(SUPPORTED(1,c)) + pname = PARTITION_NAME(SUPPORTED(2,c)) + dname = DECOMPRESSION_NAME(SUPPORTED(3,c)) + write(*,'(A,A,A,A,A,A)') sname(1:len_trim(sname)), " / ", & + pname(1:len_trim(pname)), " / ", & + dname(1:len_trim(dname)), " ..." + do order = 0, 4 + do post = 0, 1 + do dt = 0, 1 + do k = 1, 2 + o = smc_default_options() + o%structure = SUPPORTED(1,c) + o%partition = SUPPORTED(2,c) + o%decompression = SUPPORTED(3,c) + o%order = int(order, c_int) + o%postprocessing = int(post, c_int) + o%dtype = int(dt, c_int) + oname = ORDER_NAME(order) + write(label,'(A,A,A,I0,A,I0)') "order=", oname(1:len_trim(oname)),& + " postprocessing=", post, " dtype=", dt + if (SUPPORTED(1,c) == SMC_SYMMETRIC) then + call test_case(SYMM(k), o, label) + else + call test_case(NONSYM(k), o, label) + end if + end do + end do + end do + end do + + ! fast_coloring only needs one pass per combination. + do k = 1, 2 + o = smc_default_options() + o%structure = SUPPORTED(1,c) + o%partition = SUPPORTED(2,c) + o%decompression = SUPPORTED(3,c) + o%order = SMC_LARGEST_FIRST + if (SUPPORTED(1,c) == SMC_SYMMETRIC) then + call test_fast_coloring(SYMM(k), o) + else + call test_fast_coloring(NONSYM(k), o) + end if + end do + end do + end subroutine test_all_combinations + + ! index_base 0 and 1 describe the same matrix, hence the same coloring; only + ! the group members are shifted. + subroutine test_index_base() + integer :: c, k, j, g + type(SmcColoringOptions), target :: o0, o1 + type(c_ptr) :: r0, r1 + integer(c_int), target :: c0(MAXDIM), c1(MAXDIM) + integer(c_int), target :: nc0, nc1, g0, g1, s0, s1 + integer(c_int), target :: m0(MAXDIM), m1(MAXDIM) + integer(c_int) :: ret, mm, nn + logical :: same, shifted + + write(*,'(A)') "index_base 0 vs 1 ..." + do c = 1, 6 + do k = 1, 2 + o0 = smc_default_options() + o1 = smc_default_options() + o0%structure = SUPPORTED(1,c) + o1%structure = SUPPORTED(1,c) + o0%partition = SUPPORTED(2,c) + o1%partition = SUPPORTED(2,c) + o0%decompression = SUPPORTED(3,c) + o1%decompression = SUPPORTED(3,c) + o1%index_base = 1 + + r0 = c_null_ptr + r1 = c_null_ptr + if (SUPPORTED(1,c) == SMC_SYMMETRIC) then + ctx = SYMM(k)%name(1:len_trim(SYMM(k)%name)) // " / index_base" + ret = color_matrix(SYMM(k), o0, r0) + call check(ret == 0, "0-based coloring") + ret = color_matrix(SYMM1(k), o1, r1) + call check(ret == 0, "1-based coloring") + mm = SYMM(k)%m + nn = SYMM(k)%n + else + ctx = NONSYM(k)%name(1:len_trim(NONSYM(k)%name)) // " / index_base" + ret = color_matrix(NONSYM(k), o0, r0) + call check(ret == 0, "0-based coloring") + ret = color_matrix(NONSYM1(k), o1, r1) + call check(ret == 0, "1-based coloring") + mm = NONSYM(k)%m + nn = NONSYM(k)%n + end if + + nc0 = 0 + nc1 = 0 + ret = smc_ncolors(r0, c_loc(nc0)) + ret = smc_ncolors(r1, c_loc(nc1)) + call check(nc0 == nc1 .and. nc0 > 0, "index_base does not change the number of colors") + + same = .true. + if (o0%partition /= SMC_ROW) then + c0 = 0 + c1 = 0 + ret = smc_column_colors(r0, c_loc(c0), nn) + ret = smc_column_colors(r1, c_loc(c1), nn) + do j = 1, nn + if (c0(j) /= c1(j)) same = .false. + end do + end if + if (o0%partition /= SMC_COLUMN) then + c0 = 0 + c1 = 0 + ret = smc_row_colors(r0, c_loc(c0), mm) + ret = smc_row_colors(r1, c_loc(c1), mm) + do j = 1, mm + if (c0(j) /= c1(j)) same = .false. + end do + end if + call check(same, "index_base does not change the colors (colors are labels)") + + shifted = .true. + if (o0%partition /= SMC_ROW) then + g0 = 0 + g1 = 0 + ret = smc_ncolumn_groups(r0, c_loc(g0)) + ret = smc_ncolumn_groups(r1, c_loc(g1)) + call check(g0 == g1, "same number of column groups") + do g = 1, min(g0, g1) + s0 = 0 + s1 = 0 + ret = smc_column_group_size(r0, int(g, c_int), c_loc(s0)) + if (ret /= 0) shifted = .false. + ret = smc_column_group_size(r1, int(g, c_int), c_loc(s1)) + if (ret /= 0) shifted = .false. + if (s0 /= s1) then + shifted = .false. + else + m0 = 0 + m1 = 0 + ret = smc_column_group(r0, int(g, c_int), c_loc(m0), s0) + if (ret /= 0) shifted = .false. + ret = smc_column_group(r1, int(g, c_int), c_loc(m1), s1) + if (ret /= 0) shifted = .false. + do j = 1, s0 + if (m1(j) /= m0(j) + 1) shifted = .false. + end do + end if + end do + end if + if (o0%partition /= SMC_COLUMN) then + g0 = 0 + g1 = 0 + ret = smc_nrow_groups(r0, c_loc(g0)) + ret = smc_nrow_groups(r1, c_loc(g1)) + call check(g0 == g1, "same number of row groups") + do g = 1, min(g0, g1) + s0 = 0 + s1 = 0 + ret = smc_row_group_size(r0, int(g, c_int), c_loc(s0)) + if (ret /= 0) shifted = .false. + ret = smc_row_group_size(r1, int(g, c_int), c_loc(s1)) + if (ret /= 0) shifted = .false. + if (s0 /= s1) then + shifted = .false. + else + m0 = 0 + m1 = 0 + ret = smc_row_group(r0, int(g, c_int), c_loc(m0), s0) + if (ret /= 0) shifted = .false. + ret = smc_row_group(r1, int(g, c_int), c_loc(m1), s1) + if (ret /= 0) shifted = .false. + do j = 1, s0 + if (m1(j) /= m0(j) + 1) shifted = .false. + end do + end if + end do + end if + call check(shifted, "group members are shifted by exactly the index base") + + ret = smc_result_free(r0) + call check(ret == 0, "free the 0-based handle") + ret = smc_result_free(r1) + call check(ret == 0, "free the 1-based handle") + ctx = "" + end do + end do + end subroutine test_index_base + + ! postprocessing may only replace colors by the neutral color 0, never make + ! the coloring worse. + subroutine test_postprocessing() + integer :: k, j, l + type(SmcColoringOptions), target :: off, on + type(c_ptr) :: r_off, r_on + integer(c_int), target :: c_off(MAXDIM), c_on(MAXDIM), nc_off, nc_on + integer(c_int) :: ret, nn + logical :: valid, injective + + write(*,'(A)') "postprocessing ..." + do k = 1, 2 + ctx = SYMM(k)%name(1:len_trim(SYMM(k)%name)) // " / postprocessing" + off = smc_default_options() + on = smc_default_options() + off%structure = SMC_SYMMETRIC + on%structure = SMC_SYMMETRIC + on%postprocessing = 1 + + r_off = c_null_ptr + r_on = c_null_ptr + ret = color_matrix(SYMM(k), off, r_off) + call check(ret == 0, "coloring") + ret = color_matrix(SYMM(k), on, r_on) + call check(ret == 0, "coloring (postprocessed)") + + nn = SYMM(k)%n + nc_off = 0 + nc_on = 0 + c_off = 0 + c_on = 0 + ret = smc_ncolors(r_off, c_loc(nc_off)) + ret = smc_ncolors(r_on, c_loc(nc_on)) + ret = smc_column_colors(r_off, c_loc(c_off), nn) + ret = smc_column_colors(r_on, c_loc(c_on), nn) + + call check(nc_on <= nc_off, "postprocessing never increases the number of colors") + + valid = .true. + do j = 1, nn + if (c_on(j) < 0 .or. c_on(j) > nc_on) valid = .false. + if (c_off(j) < 1 .or. c_off(j) > nc_off) valid = .false. + end do + call check(valid, "colors stay in 0..ncolors, and are nonzero without postprocessing") + + ! Surviving colors are renamed injectively: two vertices keep the same + ! nonzero color together. + injective = .true. + do j = 1, nn + do l = j + 1, nn + if (c_on(j) == 0 .or. c_on(l) == 0) cycle + if ((c_on(j) == c_on(l)) .neqv. (c_off(j) == c_off(l))) injective = .false. + end do + end do + call check(injective, "postprocessing renames colors injectively") + + ret = smc_result_free(r_off) + call check(ret == 0, "free") + ret = smc_result_free(r_on) + call check(ret == 0, "free (postprocessed)") + ctx = "" + end do + end subroutine test_postprocessing + + subroutine test_version() + ! No `target` needed: smc_version's outputs are bound as intent(out) + ! scalars, not type(c_ptr), so they are passed by reference directly. + integer(c_int) :: major, minor, patch + major = -1 + minor = -1 + patch = -1 + write(*,'(A)') "version ..." + call smc_version(major, minor, patch) + call check(major == SMC_VERSION_MAJOR .and. minor == SMC_VERSION_MINOR .and. & + patch == SMC_VERSION_PATCH, & + "smc_version matches the SMC_VERSION_* parameters") + end subroutine test_version + + subroutine test_default_options() + type(SmcColoringOptions) :: o + integer :: nonzero_before + + write(*,'(A)') "default options ..." + + ! Every default is 0, so comparing the fields cannot tell a working + ! smc_default_options from one that writes nothing. It is also the only + ! entry point returning a derived type by value, so poison the struct first + ! and require the call to overwrite it: that exercises the struct-return ABI. + o%structure = 111 + o%partition = 112 + o%decompression = 113 + o%order = 114 + o%postprocessing = 115 + o%symmetric_pattern = 116 + o%index_base = 117 + o%dtype = 118 + nonzero_before = o%structure + o%dtype + + o = smc_default_options() + + call check(nonzero_before == 229, & + "the poison values were actually stored (sanity)") + call check(o%structure /= 111 .and. o%dtype /= 118, & + "smc_default_options overwrites the struct (struct-return ABI)") + call check(o%structure == SMC_NONSYMMETRIC, "default structure is SMC_NONSYMMETRIC") + call check(o%partition == SMC_COLUMN, "default partition is SMC_COLUMN") + call check(o%decompression == SMC_DIRECT, "default decompression is SMC_DIRECT") + call check(o%order == SMC_NATURAL, "default order is SMC_NATURAL") + call check(o%postprocessing == 0, "default postprocessing is 0") + call check(o%symmetric_pattern == 0, "default symmetric_pattern is 0") + call check(o%index_base == 0, "default index_base is 0") + call check(o%dtype == SMC_FLOAT64, "default dtype is SMC_FLOAT64") + end subroutine test_default_options + + ! A c_null_ptr options argument must behave exactly like smc_default_options(). + subroutine test_null_options() + type(SmcColoringOptions), target :: o + type(c_ptr) :: r_null, r_def + integer(c_int), target :: a(MAXDIM), b(MAXDIM) + integer(c_int) :: ret, nn + integer :: j + logical :: same + + write(*,'(A)') "c_null_ptr options ..." + o = smc_default_options() + nn = NONSYM(1)%n + a = 0 + b = 0 + + r_null = c_null_ptr + r_def = c_null_ptr + ret = smc_coloring(NONSYM(1)%m, nn, c_loc(NONSYM(1)%colptr), & + c_loc(NONSYM(1)%rowval), c_null_ptr, r_null) + call check(ret == 0, "smc_coloring accepts c_null_ptr options") + ret = color_matrix(NONSYM(1), o, r_def) + call check(ret == 0, "smc_coloring accepts smc_default_options()") + + ret = smc_column_colors(r_null, c_loc(a), nn) + call check(ret == 0, "colors with c_null_ptr options") + ret = smc_column_colors(r_def, c_loc(b), nn) + call check(ret == 0, "colors with explicit defaults") + + same = .true. + do j = 1, nn + if (a(j) /= b(j)) same = .false. + end do + call check(same, "c_null_ptr options == smc_default_options()") + + ret = smc_result_free(r_null) + call check(ret == 0, "free") + ret = smc_result_free(r_def) + call check(ret == 0, "free") + end subroutine test_null_options + + ! Return code -2: an unsupported (structure, partition, decompression). + subroutine test_unsupported_combinations() + integer :: c, dt + type(SmcColoringOptions), target :: o + type(c_ptr) :: result + integer(c_int), target :: rows(MAXDIM), cols(MAXDIM), nc + integer(c_int) :: ret + + write(*,'(A)') "unsupported combinations ..." + do c = 1, 6 + do dt = 0, 1 + o = smc_default_options() + o%structure = UNSUPPORTED(1,c) + o%partition = UNSUPPORTED(2,c) + o%decompression = UNSUPPORTED(3,c) + o%dtype = int(dt, c_int) + + result = c_null_ptr + ret = color_matrix(SYMM(1), o, result) + call check(ret == -2, "an unsupported combination returns -2") + + nc = -1 + rows = 0 + cols = 0 + ret = smc_fast_coloring(SYMM(1)%m, SYMM(1)%n, c_loc(SYMM(1)%colptr), & + c_loc(SYMM(1)%rowval), c_loc(o), & + c_loc(rows), c_loc(cols), c_loc(nc)) + call check(ret == -2, "smc_fast_coloring rejects the same combination with -2") + end do + end do + end subroutine test_unsupported_combinations + + ! Return code -3: invalid arguments and short buffers. + subroutine test_invalid_arguments() + type(SmcColoringOptions), target :: o, bad + type(c_ptr) :: result + integer(c_int), target :: colors(MAXDIM), members(MAXDIM) + integer(c_int), target :: ngroups, gsize + integer(c_int) :: ret, mm, nn + integer :: f + + write(*,'(A)') "invalid arguments ..." + o = smc_default_options() + mm = NONSYM(1)%m + nn = NONSYM(1)%n + result = c_null_ptr + + ret = smc_coloring(mm, nn, c_null_ptr, c_loc(NONSYM(1)%rowval), c_loc(o), result) + call check(ret == -3, "a c_null_ptr colptr returns -3") + ret = smc_coloring(mm, nn, c_loc(NONSYM(1)%colptr), c_null_ptr, c_loc(o), result) + call check(ret == -3, "a c_null_ptr rowval returns -3") + ret = smc_coloring(0_c_int, nn, c_loc(NONSYM(1)%colptr), & + c_loc(NONSYM(1)%rowval), c_loc(o), result) + call check(ret == -3, "m == 0 returns -3") + ret = smc_coloring(mm, 0_c_int, c_loc(NONSYM(1)%colptr), & + c_loc(NONSYM(1)%rowval), c_loc(o), result) + call check(ret == -3, "n == 0 returns -3") + ret = smc_coloring(-1_c_int, nn, c_loc(NONSYM(1)%colptr), & + c_loc(NONSYM(1)%rowval), c_loc(o), result) + call check(ret == -3, "m < 0 returns -3") + + do f = 1, 6 + bad = smc_default_options() + select case (f) + case (1) + bad%structure = 5 + case (2) + bad%partition = 9 + case (3) + bad%decompression = 7 + case (4) + bad%order = 9 + case (5) + bad%dtype = 4 + case default + bad%index_base = 2 + end select + result = c_null_ptr + ret = color_matrix(NONSYM(1), bad, result) + call check(ret == -3, "an out-of-range enum or index_base returns -3") + end do + + result = c_null_ptr + ret = color_matrix(NONSYM(1), o, result) + call check(ret == 0, "reference coloring") + + ret = smc_column_colors(result, c_loc(colors), nn - 1) + call check(ret == -3, "len < n returns -3") + ret = smc_column_colors(result, c_null_ptr, nn) + call check(ret == -3, "a c_null_ptr colors buffer returns -3") + ret = smc_ncolors(result, c_null_ptr) + call check(ret == -3, "a c_null_ptr ncolors_out returns -3") + ret = smc_ncolumn_groups(result, c_null_ptr) + call check(ret == -3, "a c_null_ptr ngroups_out returns -3") + ret = smc_compressed_size(result, c_null_ptr, c_null_ptr, c_null_ptr, c_null_ptr) + call check(ret == -3, "c_null_ptr size outputs return -3") + ret = smc_nnz(result, c_null_ptr) + call check(ret == -3, "a c_null_ptr nnz_out returns -3") + ret = smc_size(result, c_null_ptr, c_null_ptr) + call check(ret == -3, "a c_null_ptr m_out / n_out returns -3") + + ngroups = 0 + ret = smc_ncolumn_groups(result, c_loc(ngroups)) + call check(ret == 0 .and. ngroups > 0, "smc_ncolumn_groups succeeds") + gsize = 0 + ret = smc_column_group_size(result, 0_c_int, c_loc(gsize)) + call check(ret == -3, "group 0 is out of range") + ret = smc_column_group_size(result, ngroups + 1, c_loc(gsize)) + call check(ret == -3, "group ngroups+1 is out of range") + ret = smc_column_group_size(result, 1_c_int, c_loc(gsize)) + call check(ret == 0 .and. gsize > 0, "group 1 has a size") + ! Only understate a length that is positive; see pitfall 2 in the header. + if (gsize > 0) then + ret = smc_column_group(result, 1_c_int, c_loc(members), gsize - 1) + call check(ret == -3, "a short group buffer returns -3") + end if + ret = smc_column_group(result, 1_c_int, c_null_ptr, gsize) + call check(ret == -3, "a c_null_ptr group buffer returns -3") + + ret = smc_row_colors(result, c_loc(colors), mm) + call check(ret == -2, "smc_row_colors on a column partition returns -2") + ret = smc_nrow_groups(result, c_loc(ngroups)) + call check(ret == -2, "smc_nrow_groups on a column partition returns -2") + + ret = smc_result_free(result) + call check(ret == 0, "free") + end subroutine test_invalid_arguments + + ! Return code -4: a freed or never-allocated handle. + subroutine test_invalid_handle() + type(SmcColoringOptions), target :: o + type(c_ptr) :: result, bogus + integer(c_int), target :: colors(MAXDIM), members(MAXDIM), value + integer(c_int), target :: not_a_handle + real(c_double), target :: buf(MAXDIM*MAXDIM) + integer(c_int) :: ret, mm, nn + integer(c_size_t) :: buf_len + + write(*,'(A)') "invalid and already-freed handles ..." + o = smc_default_options() + mm = NONSYM(1)%m + nn = NONSYM(1)%n + colors = 0 + members = 0 + value = 0 + buf = 0.0_c_double + buf_len = int(mm, c_size_t) * int(nn, c_size_t) + not_a_handle = 0 + + result = c_null_ptr + ret = color_matrix(NONSYM(1), o, result) + call check(ret == 0, "coloring for the free test") + ret = smc_result_free(result) + call check(ret == 0, "the first free returns 0") + ret = smc_result_free(result) + call check(ret == -4, "a double free returns -4") + + ! Every entry point must reject the stale handle rather than dereference it. + ret = smc_ncolors(result, c_loc(value)) + call check(ret == -4, "smc_ncolors after free returns -4") + ret = smc_column_colors(result, c_loc(colors), nn) + call check(ret == -4, "smc_column_colors after free returns -4") + ret = smc_row_colors(result, c_loc(colors), mm) + call check(ret == -4, "smc_row_colors after free returns -4") + ret = smc_ncolumn_groups(result, c_loc(value)) + call check(ret == -4, "smc_ncolumn_groups after free returns -4") + ret = smc_nrow_groups(result, c_loc(value)) + call check(ret == -4, "smc_nrow_groups after free returns -4") + ret = smc_column_group_size(result, 1_c_int, c_loc(value)) + call check(ret == -4, "smc_column_group_size after free returns -4") + ret = smc_column_group(result, 1_c_int, c_loc(members), nn) + call check(ret == -4, "smc_column_group after free returns -4") + ret = smc_row_group_size(result, 1_c_int, c_loc(value)) + call check(ret == -4, "smc_row_group_size after free returns -4") + ret = smc_row_group(result, 1_c_int, c_loc(members), mm) + call check(ret == -4, "smc_row_group after free returns -4") + ret = smc_compressed_size(result, c_loc(value), c_loc(value), c_loc(value), c_loc(value)) + call check(ret == -4, "smc_compressed_size after free returns -4") + ret = smc_nnz(result, c_loc(value)) + call check(ret == -4, "smc_nnz after free returns -4") + ret = smc_size(result, c_loc(value), c_loc(value)) + call check(ret == -4, "smc_size after free returns -4") + ret = smc_compress(result, c_loc(NONSYM(1)%nzval), int(NONSYM(1)%nnz, c_size_t), & + c_null_ptr, 0_c_size_t, c_loc(buf), buf_len) + call check(ret == -4, "smc_compress after free returns -4") + ret = smc_decompress(result, c_null_ptr, 0_c_size_t, c_loc(buf), buf_len, & + c_loc(buf), buf_len) + call check(ret == -4, "smc_decompress after free returns -4") + + bogus = c_loc(not_a_handle) + ret = smc_result_free(bogus) + call check(ret == -4, "freeing a never-allocated handle returns -4") + ret = smc_ncolors(bogus, c_loc(value)) + call check(ret == -4, "querying a never-allocated handle returns -4") + + ret = smc_result_free(c_null_ptr) + call check(ret == -3 .or. ret == -4, "freeing c_null_ptr is rejected, not a crash") + end subroutine test_invalid_handle + + subroutine test_sizing_queries() + integer :: c, dt + type(SmcColoringOptions), target :: o + type(c_ptr) :: result + integer(c_int), target :: got_nnz, got_m, got_n + integer(c_int) :: ret, want_m, want_n, want_nnz + logical :: symmetric + + write(*,'(A)') "smc_nnz / smc_size ..." + do c = 1, 6 + do dt = 0, 1 + o = smc_default_options() + o%structure = SUPPORTED(1,c) + o%partition = SUPPORTED(2,c) + o%decompression = SUPPORTED(3,c) + o%dtype = int(dt, c_int) + + symmetric = (SUPPORTED(1,c) == SMC_SYMMETRIC) + if (symmetric) then + want_m = SYMM(1)%m + want_n = SYMM(1)%n + want_nnz = SYMM(1)%nnz + else + want_m = NONSYM(1)%m + want_n = NONSYM(1)%n + want_nnz = NONSYM(1)%nnz + end if + + result = c_null_ptr + if (symmetric) then + ret = color_matrix(SYMM(1), o, result) + else + ret = color_matrix(NONSYM(1), o, result) + end if + call check(ret == 0, "coloring for the sizing queries") + + got_nnz = -1 + ret = smc_nnz(result, c_loc(got_nnz)) + call check(ret == 0 .and. got_nnz == want_nnz, & + "smc_nnz is the number of stored entries") + + got_m = -1 + got_n = -1 + ret = smc_size(result, c_loc(got_m), c_loc(got_n)) + call check(ret == 0 .and. got_m == want_m .and. got_n == want_n, & + "smc_size is the shape of the colored matrix") + + ret = smc_nnz(result, c_null_ptr) + call check(ret == -3, "a c_null_ptr nnz_out returns -3") + ret = smc_size(result, c_null_ptr, c_loc(got_n)) + call check(ret == -3, "a c_null_ptr m_out returns -3") + ret = smc_size(result, c_loc(got_m), c_null_ptr) + call check(ret == -3, "a c_null_ptr n_out returns -3") + + ret = smc_result_free(result) + call check(ret == 0, "free") + ret = smc_nnz(result, c_loc(got_nnz)) + call check(ret == -4, "smc_nnz on a freed handle returns -4") + ret = smc_size(result, c_loc(got_m), c_loc(got_n)) + call check(ret == -4, "smc_size on a freed handle returns -4") + end do + end do + end subroutine test_sizing_queries + +end program test_smc diff --git a/interfaces/test/test_libsmc.jl b/interfaces/test/test_libsmc.jl new file mode 100644 index 00000000..ba27c559 --- /dev/null +++ b/interfaces/test/test_libsmc.jl @@ -0,0 +1,1370 @@ +# Validates the C interface by loading LibSMC.jl as a plain Julia module and +# calling its @ccallable functions directly. Loading the juliac-compiled +# libsmc.so from a Julia process would start a second Julia runtime and crash, +# so the compiled library is tested separately from C (interfaces/test/C/). +# +# julia --startup-file=no --project=. interfaces/test/test_libsmc.jl + +using Test +using SparseArrays +using SparseMatrixColorings + +include(joinpath(@__DIR__, "..", "src", "LibSMC.jl")) +using .LibSMC + +# Enums — must match interfaces/include/smc.h and interfaces/src/c_enums.jl + +const SMC_FLOAT64 = Cint(0) +const SMC_FLOAT32 = Cint(1) + +const SMC_NONSYMMETRIC = Cint(0) +const SMC_SYMMETRIC = Cint(1) + +const SMC_COLUMN = Cint(0) +const SMC_ROW = Cint(1) +const SMC_BIDIRECTIONAL = Cint(2) + +const SMC_DIRECT = Cint(0) +const SMC_SUBSTITUTION = Cint(1) + +const SMC_NATURAL = Cint(0) +const SMC_LARGEST_FIRST = Cint(1) +const SMC_SMALLEST_LAST = Cint(2) +const SMC_INCIDENCE_DEGREE = Cint(3) +const SMC_DYNAMIC_LARGEST_FIRST = Cint(4) + +const ALL_ORDERS = ( + SMC_NATURAL, + SMC_LARGEST_FIRST, + SMC_SMALLEST_LAST, + SMC_INCIDENCE_DEGREE, + SMC_DYNAMIC_LARGEST_FIRST, +) + +# Julia counterparts, indexed by `order + 1`. RandomOrder is excluded from v1. +const ORDER_OBJECTS = ( + NaturalOrder(), LargestFirst(), SmallestLast(), IncidenceDegree(), DynamicLargestFirst() +) + +const SUPPORTED_COMBOS = ( + (SMC_NONSYMMETRIC, SMC_COLUMN, SMC_DIRECT), + (SMC_NONSYMMETRIC, SMC_ROW, SMC_DIRECT), + (SMC_SYMMETRIC, SMC_COLUMN, SMC_DIRECT), + (SMC_SYMMETRIC, SMC_COLUMN, SMC_SUBSTITUTION), + (SMC_NONSYMMETRIC, SMC_BIDIRECTIONAL, SMC_DIRECT), + (SMC_NONSYMMETRIC, SMC_BIDIRECTIONAL, SMC_SUBSTITUTION), +) + +const UNSUPPORTED_COMBOS = ( + (SMC_NONSYMMETRIC, SMC_COLUMN, SMC_SUBSTITUTION), + (SMC_NONSYMMETRIC, SMC_ROW, SMC_SUBSTITUTION), + (SMC_SYMMETRIC, SMC_ROW, SMC_DIRECT), + (SMC_SYMMETRIC, SMC_ROW, SMC_SUBSTITUTION), + (SMC_SYMMETRIC, SMC_BIDIRECTIONAL, SMC_DIRECT), + (SMC_SYMMETRIC, SMC_BIDIRECTIONAL, SMC_SUBSTITUTION), +) + +structure_symbol(s) = s == SMC_NONSYMMETRIC ? :nonsymmetric : :symmetric +partition_symbol(p) = p == SMC_COLUMN ? :column : (p == SMC_ROW ? :row : :bidirectional) +decompression_symbol(d) = d == SMC_DIRECT ? :direct : :substitution +value_type(dt) = dt == SMC_FLOAT64 ? Float64 : Float32 + +# Calling the @ccallable entry points. `Base.@ccallable` defines ordinary Julia +# methods, so rather than hard-coding the declared pointer types we read the +# (unique) method signature and convert each argument accordingly. + +function _argument_types(f) + ms = collect(methods(f)) + length(ms) == 1 || error("expected exactly 1 method for $f, found $(length(ms))") + return collect(Base.tuple_type_tail(ms[1].sig).parameters) +end + +_raw_pointer(x::Base.RefValue{S}) where {S} = Base.unsafe_convert(Ptr{S}, x) +_raw_pointer(x::Array{S}) where {S} = pointer(x) +_raw_pointer(x::Ptr) = x + +_convert_argument(::Type{P}, x) where {P<:Ptr} = convert(P, _raw_pointer(x)) +_convert_argument(::Type{T}, x) where {T} = convert(T, x)::T + +function ccallable_call(f, args...) + types = _argument_types(f) + length(types) == length(args) || + error("$f expects $(length(types)) arguments, got $(length(args))") + GC.@preserve args begin + converted = ntuple(i -> _convert_argument(types[i], args[i]), length(args)) + return f(converted...) + end +end + +# Recover the options struct type from the entry point that returns it, so this +# file does not depend on its Julia-side name. +const SmcOptions = typeof(LibSMC.smc_default_options()) + +const DEFAULT_OPTIONS = ( + structure=SMC_NONSYMMETRIC, + partition=SMC_COLUMN, + decompression=SMC_DIRECT, + order=SMC_NATURAL, + postprocessing=Cint(0), + symmetric_pattern=Cint(0), + index_base=Cint(0), + dtype=SMC_FLOAT64, +) + +""" + options(; kwargs...) + +Named tuple of the eight `SmcColoringOptions` fields, with their defaults. +""" +options(; kwargs...) = merge(DEFAULT_OPTIONS, NamedTuple(k => Cint(v) for (k, v) in kwargs)) + +# Positional construction: c_enums.jl pins the field *order*, not the names. +function options_struct(o) + return SmcOptions( + o.structure, + o.partition, + o.decompression, + o.order, + o.postprocessing, + o.symmetric_pattern, + o.index_base, + o.dtype, + ) +end + +# Thin wrappers mirroring the C prototypes in smc.h + +"CSC arrays of `S`, as `Cint` in the requested index base." +function csc_arrays(S::SparseMatrixCSC, base::Integer) + colptr = Cint.(S.colptr .- 1 .+ base) + rowval = Cint.(S.rowval .- 1 .+ base) + return colptr, rowval +end + +function c_coloring(S::SparseMatrixCSC, o) + colptr, rowval = csc_arrays(S, o.index_base) + opts = Ref(options_struct(o)) + handle = Ref(Ptr{Cvoid}(C_NULL)) + ret = ccallable_call( + LibSMC.smc_coloring, size(S, 1), size(S, 2), colptr, rowval, opts, handle + ) + return Int(ret), handle[] +end + +"Compute a coloring, failing the test (loudly) if the call does not succeed." +function c_coloring_ok(S::SparseMatrixCSC, o) + ret, handle = c_coloring(S, o) + ret == 0 || error("smc_coloring returned $ret for options $o") + handle != C_NULL || error("smc_coloring returned a NULL handle for options $o") + return handle +end + +c_result_free(handle) = Int(ccallable_call(LibSMC.smc_result_free, handle)) + +function c_ncolors(handle) + out = Ref(Cint(-1)) + ret = ccallable_call(LibSMC.smc_ncolors, handle, out) + return Int(ret), Int(out[]) +end + +# At least one element, so a short `len` is tested against a non-NULL buffer. +function c_colors(f, handle, len::Integer) + buffer = fill(Cint(-999), max(len, 1)) + ret = ccallable_call(f, handle, buffer, len) + return Int(ret), Int.(buffer[1:max(len, 0)]) +end + +c_column_colors(handle, n) = c_colors(LibSMC.smc_column_colors, handle, n) +c_row_colors(handle, m) = c_colors(LibSMC.smc_row_colors, handle, m) + +function c_ngroups(f, handle) + out = Ref(Cint(-1)) + ret = ccallable_call(f, handle, out) + return Int(ret), Int(out[]) +end + +c_ncolumn_groups(handle) = c_ngroups(LibSMC.smc_ncolumn_groups, handle) +c_nrow_groups(handle) = c_ngroups(LibSMC.smc_nrow_groups, handle) + +function c_group_size(f, handle, group::Integer) + out = Ref(Cint(-1)) + ret = ccallable_call(f, handle, group, out) + return Int(ret), Int(out[]) +end + +function c_group(f, handle, group::Integer, len::Integer) + buffer = fill(Cint(-999), max(len, 1)) + ret = ccallable_call(f, handle, group, buffer, len) + return Int(ret), Int.(buffer[1:max(len, 0)]) +end + +"All column groups as a vector of member-index vectors (in the caller's index base)." +function c_column_groups(handle) + ret, ngroups = c_ncolumn_groups(handle) + ret == 0 || error("smc_ncolumn_groups returned $ret") + return [ + begin + rs, size = c_group_size(LibSMC.smc_column_group_size, handle, g) + rs == 0 || error("smc_column_group_size($g) returned $rs") + rg, members = c_group(LibSMC.smc_column_group, handle, g, size) + rg == 0 || error("smc_column_group($g) returned $rg") + members + end for g in 1:ngroups + ] +end + +function c_row_groups(handle) + ret, ngroups = c_nrow_groups(handle) + ret == 0 || error("smc_nrow_groups returned $ret") + return [ + begin + rs, size = c_group_size(LibSMC.smc_row_group_size, handle, g) + rs == 0 || error("smc_row_group_size($g) returned $rs") + rg, members = c_group(LibSMC.smc_row_group, handle, g, size) + rg == 0 || error("smc_row_group($g) returned $rg") + members + end for g in 1:ngroups + ] +end + +function c_compressed_size(handle) + br_rows = Ref(Cint(-1)) + br_cols = Ref(Cint(-1)) + bc_rows = Ref(Cint(-1)) + bc_cols = Ref(Cint(-1)) + ret = ccallable_call( + LibSMC.smc_compressed_size, handle, br_rows, br_cols, bc_rows, bc_cols + ) + return Int(ret), (Int(br_rows[]), Int(br_cols[]), Int(bc_rows[]), Int(bc_cols[])) +end + +"Number of stored entries of the pattern: the required `nzval_len`." +function c_nnz(handle) + out = Ref(Cint(-1)) + ret = ccallable_call(LibSMC.smc_nnz, handle, out) + return Int(ret), Int(out[]) +end + +"Dimensions of the colored matrix: `A_len` must be at least their product." +function c_size(handle) + m_out = Ref(Cint(-1)) + n_out = Ref(Cint(-1)) + ret = ccallable_call(LibSMC.smc_size, handle, m_out, n_out) + return Int(ret), (Int(m_out[]), Int(n_out[])) +end + +# Buffers are pre-filled with a sentinel: compress and decompress write the +# *whole* dense output, so no sentinel may survive a successful call, and every +# sentinel must survive a call rejected for a short buffer. +const SENTINEL = -987.0 + +""" + c_compress(handle, nzval, dims; kwargs...) + +Call `smc_compress` with buffers of exactly the size `smc_compressed_size` +announced. `nzval_len`, `Br_len` and `Bc_len` default to the true length of +their buffer and can each be understated on its own, so a short length is a lie +about a valid buffer. `*_null` replaces a buffer by NULL. +""" +function c_compress( + handle, + nzval::Vector{T}, + dims; + nzval_len=nothing, + Br_len=nothing, + Bc_len=nothing, + nzval_null=false, + Br_null=false, + Bc_null=false, +) where {T} + br_rows, br_cols, bc_rows, bc_cols = dims + Br = fill(T(SENTINEL), br_rows, br_cols) + Bc = fill(T(SENTINEL), bc_rows, bc_cols) + nullptr = Ptr{Cvoid}(C_NULL) + nzval_arg = nzval_null ? nullptr : nzval + # Br is NULL with a length of 0 for every non-bidirectional partition. + Br_arg = (Br_null || isempty(Br)) ? nullptr : Br + Bc_arg = Bc_null ? nullptr : Bc + ret = ccallable_call( + LibSMC.smc_compress, + handle, + nzval_arg, + something(nzval_len, length(nzval)), + Br_arg, + something(Br_len, length(Br)), + Bc_arg, + something(Bc_len, length(Bc)), + ) + return Int(ret), Br, Bc +end + +""" + c_decompress(handle, Br, Bc, m, n; kwargs...) + +Same conventions as [`c_compress`](@ref); the `A_out` buffer is always `m`-by-`n`. +""" +function c_decompress( + handle, + Br::Matrix{T}, + Bc::Matrix{T}, + m::Integer, + n::Integer; + Br_len=nothing, + Bc_len=nothing, + A_len=nothing, + Br_null=false, + Bc_null=false, + A_null=false, +) where {T} + A = fill(T(SENTINEL), m, n) + nullptr = Ptr{Cvoid}(C_NULL) + Br_arg = (Br_null || isempty(Br)) ? nullptr : Br + Bc_arg = Bc_null ? nullptr : Bc + A_arg = A_null ? nullptr : A + ret = ccallable_call( + LibSMC.smc_decompress, + handle, + Br_arg, + something(Br_len, length(Br)), + Bc_arg, + something(Bc_len, length(Bc)), + A_arg, + something(A_len, length(A)), + ) + return Int(ret), A +end + +function c_fast_coloring(S::SparseMatrixCSC, o; row_buffer=true, column_buffer=true) + m, n = size(S) + colptr, rowval = csc_arrays(S, o.index_base) + opts = Ref(options_struct(o)) + row_colors = fill(Cint(-999), m) + column_colors = fill(Cint(-999), n) + nc = Ref(Cint(-1)) + ret = ccallable_call( + LibSMC.smc_fast_coloring, + m, + n, + colptr, + rowval, + opts, + row_buffer ? row_colors : Ptr{Cvoid}(C_NULL), + column_buffer ? column_colors : Ptr{Cvoid}(C_NULL), + nc, + ) + return Int(ret), Int.(row_colors), Int.(column_colors), Int(nc[]) +end + +function c_version() + major = Ref(Cint(-1)) + minor = Ref(Cint(-1)) + patch = Ref(Cint(-1)) + ccallable_call(LibSMC.smc_version, major, minor, patch) + return Int(major[]), Int(minor[]), Int(patch[]) +end + +# Reference oracle: plain Julia SparseMatrixColorings + +function reference_result(S::SparseMatrixCSC, o) + problem = ColoringProblem{structure_symbol(o.structure),partition_symbol(o.partition)}() + algorithm = GreedyColoringAlgorithm{decompression_symbol(o.decompression)}( + ORDER_OBJECTS[o.order + 1]; postprocessing=(o.postprocessing != 0) + ) + return coloring( + S, + problem, + algorithm; + decompression_eltype=value_type(o.dtype), + symmetric_pattern=(o.symmetric_pattern != 0), + ) +end + +# Structural validity, checked from first principles + +"Row indices of the nonzeros of column `j` (1-based)." +column_support(S::SparseMatrixCSC, j) = Set(view(rowvals(S), nzrange(S, j))) + +""" + check_column_disjointness(S, colors) + +Two columns carrying the same nonzero color must not share a nonzero row. +""" +function check_column_disjointness(S::SparseMatrixCSC, colors::Vector{Int}) + n = size(S, 2) + @test length(colors) == n + supports = [column_support(S, j) for j in 1:n] + offenders = Tuple{Int,Int}[] + for j in 1:n, k in (j + 1):n + (colors[j] == 0 || colors[k] == 0) && continue + if colors[j] == colors[k] && !isdisjoint(supports[j], supports[k]) + push!(offenders, (j, k)) + end + end + @test isempty(offenders) +end + +function check_row_disjointness(S::SparseMatrixCSC, colors::Vector{Int}) + return check_column_disjointness(SparseMatrixCSC(transpose(S)), colors) +end + +"Adjacency lists of the off-diagonal pattern of a (structurally symmetric) `S`." +function adjacency_lists(S::SparseMatrixCSC) + n = size(S, 2) + neighbours = [Int[] for _ in 1:n] + rows = rowvals(S) + for j in 1:n, k in nzrange(S, j) + i = rows[k] + i == j || push!(neighbours[j], i) + end + return neighbours +end + +"Edges `(i, j)` with `i < j` of the off-diagonal pattern." +function edge_list(S::SparseMatrixCSC) + edges = Tuple{Int,Int}[] + rows = rowvals(S) + for j in 1:size(S, 2), k in nzrange(S, j) + i = rows[k] + i < j && push!(edges, (i, j)) + end + return edges +end + +""" + check_proper_coloring(S, colors) + +Adjacent vertices carry different (nonzero) colors. +""" +function check_proper_coloring(S::SparseMatrixCSC, colors::Vector{Int}) + bad = Tuple{Int,Int}[] + for (i, j) in edge_list(S) + (colors[i] == 0 || colors[j] == 0) && continue + colors[i] == colors[j] && push!(bad, (i, j)) + end + @test isempty(bad) +end + +""" + check_star_coloring(S, colors) + +No bicolored path on four vertices `i - j - k - l`: the structural requirement +for *direct* decompression of a symmetric matrix. +""" +function check_star_coloring(S::SparseMatrixCSC, colors::Vector{Int}) + neighbours = adjacency_lists(S) + bad = NTuple{4,Int}[] + for (j, k) in edge_list(S) + for i in neighbours[j], l in neighbours[k] + (i == k || l == j || i == l) && continue + (colors[i] == 0 || colors[j] == 0 || colors[k] == 0 || colors[l] == 0) && + continue + if colors[i] == colors[k] && colors[j] == colors[l] + push!(bad, (i, j, k, l)) + end + end + end + @test isempty(bad) +end + +"Union-find root with path compression." +function _find(parent::Dict{Int,Int}, x::Int) + root = x + while parent[root] != root + root = parent[root] + end + while parent[x] != root + parent[x], x = root, parent[x] + end + return root +end + +""" + check_acyclic_coloring(S, colors) + +Every subgraph induced by two colors is a forest. This is the structural +requirement for decompression by *substitution* on a symmetric matrix. +""" +function check_acyclic_coloring(S::SparseMatrixCSC, colors::Vector{Int}) + bicolored = Dict{Tuple{Int,Int},Vector{Tuple{Int,Int}}}() + for (i, j) in edge_list(S) + (colors[i] == 0 || colors[j] == 0) && continue + key = minmax(colors[i], colors[j]) + push!(get!(bicolored, key, Tuple{Int,Int}[]), (i, j)) + end + cycles = Tuple{Int,Int}[] + for (key, edges) in bicolored + parent = Dict{Int,Int}() + for (i, j) in edges + get!(parent, i, i) + get!(parent, j, j) + end + for (i, j) in edges + ri, rj = _find(parent, i), _find(parent, j) + ri == rj ? push!(cycles, key) : (parent[ri] = rj) + end + end + @test isempty(cycles) +end + +""" + check_direct_recoverability(S, row_colors, column_colors) + +Every nonzero `A[i, j]` can be read off the compressed matrix, either from +`Bc[i, column_colors[j]]` (when no other column of that color has a nonzero in +row `i`) or from `Br[row_colors[i], j]` (mirrored condition). Pass +`row_colors = nothing` for a column partition, `column_colors = nothing` for a +row partition. +""" +function check_direct_recoverability(S::SparseMatrixCSC, row_colors, column_colors) + m, n = size(S) + A = Matrix(S) + unrecoverable = Tuple{Int,Int}[] + for j in 1:n, i in 1:m + iszero(A[i, j]) && continue + by_column = false + if column_colors !== nothing && column_colors[j] != 0 + by_column = + !any( + k -> k != j && !iszero(A[i, k]) && column_colors[k] == column_colors[j], + 1:n, + ) + end + by_row = false + if row_colors !== nothing && row_colors[i] != 0 + by_row = + !any(k -> k != i && !iszero(A[k, j]) && row_colors[k] == row_colors[i], 1:m) + end + (by_column || by_row) || push!(unrecoverable, (i, j)) + end + @test isempty(unrecoverable) +end + +""" + check_symmetric_recoverability(S, colors) + +Symmetric counterpart of [`check_direct_recoverability`](@ref): with a single +column-compressed `B`, `A[i, j]` is read from `B[i, colors[j]]` when column `j` +is the only one of its color meeting row `i`, or from `B[j, colors[i]]` by +symmetry. +""" +function check_symmetric_recoverability(S::SparseMatrixCSC, colors::Vector{Int}) + n = size(S, 2) + A = Matrix(S) + unique_in_row(i, c, skip) = + !any(k -> k != skip && !iszero(A[i, k]) && colors[k] == c, 1:n) + unrecoverable = Tuple{Int,Int}[] + for j in 1:n, i in 1:n + iszero(A[i, j]) && continue + by_j = colors[j] != 0 && unique_in_row(i, colors[j], j) + by_i = colors[i] != 0 && unique_in_row(j, colors[i], i) + (by_j || by_i) || push!(unrecoverable, (i, j)) + end + @test isempty(unrecoverable) +end + +""" + check_groups(groups, colors, base) + +The groups are exactly the fibers of the color vector: group `g` lists the +indices of color `g`, in the caller's index base. +""" +function check_groups(groups::Vector{Vector{Int}}, colors::Vector{Int}, base::Integer) + expected = [findall(==(g), colors) .- 1 .+ base for g in 1:length(groups)] + @test [sort(g) for g in groups] == expected + members = reduce(vcat, groups; init=Int[]) + @test length(members) == length(unique(members)) # disjoint + @test sort(members) == findall(!=(0), colors) .- 1 .+ base # and exhaustive + @test all(0 .<= colors .<= length(groups)) +end + +# Test matrices (integer valued, so Float32 and Float64 arithmetic is exact) + +# 4x6 rectangular, nonsymmetric (the matrix from the `compress` docstring) +const A_NONSYM = sparse(Float64[ + 0 0 4 6 0 9 + 1 0 0 0 7 0 + 0 2 0 0 8 0 + 0 3 5 0 0 0 +]) + +# 7x5 rectangular, more nonzeros per row/column +const A_NONSYM2 = sparse( + Float64[ + 1 0 0 2 0 + 3 4 0 0 5 + 0 6 7 0 0 + 0 0 8 9 0 + 2 0 0 3 4 + 0 5 0 0 6 + 7 0 8 0 0 + ] +) + +# 7x7 symmetric, nonzero diagonal (arrow + tridiagonal) +const A_SYM = sparse( + Float64[ + 2 1 0 0 0 0 3 + 1 2 1 0 0 0 0 + 0 1 2 1 0 0 0 + 0 0 1 2 1 0 0 + 0 0 0 1 2 1 0 + 0 0 0 0 1 2 1 + 3 0 0 0 0 1 2 + ], +) + +# 6x6 symmetric with a *zero diagonal*, so postprocessing can assign color 0. +const A_SYM_ZERO_DIAG = sparse( + Float64[ + 0 1 1 0 0 0 + 1 0 0 1 0 0 + 1 0 0 0 1 0 + 0 1 0 0 0 1 + 0 0 1 0 0 1 + 0 0 0 1 1 0 + ] +) + +function matrices_for(structure) + return structure == SMC_SYMMETRIC ? (A_SYM, A_SYM_ZERO_DIAG) : (A_NONSYM, A_NONSYM2) +end + +# 1. Options: layout, defaults + +function test_options() + @test fieldcount(SmcOptions) == 8 + @test all(T -> T === Cint, fieldtypes(SmcOptions)) + @test sizeof(SmcOptions) == 8 * sizeof(Cint) + @test isbitstype(SmcOptions) + + defaults = LibSMC.smc_default_options() + values = [getfield(defaults, i) for i in 1:8] + @test values == + Cint[SMC_NONSYMMETRIC, SMC_COLUMN, SMC_DIRECT, SMC_NATURAL, 0, 0, 0, SMC_FLOAT64] +end + +function test_version() + major, minor, patch = c_version() + v = pkgversion(SparseMatrixColorings) + @test (major, minor, patch) == (v.major, v.minor, v.patch) +end + +# 2. Coloring: structural validity + agreement with the Julia oracle + +function test_coloring(S, o) + m, n = size(S) + handle = c_coloring_ok(S, o) + try + reference = reference_result(S, o) + + ret, nc = c_ncolors(handle) + @test ret == 0 + @test nc == ncolors(reference) + + if o.partition != SMC_ROW + ret, colors = c_column_colors(handle, n) + @test ret == 0 + @test colors == column_colors(reference) + groups = c_column_groups(handle) + check_groups(groups, colors, o.index_base) + end + if o.partition != SMC_COLUMN + ret, colors = c_row_colors(handle, m) + @test ret == 0 + @test colors == row_colors(reference) + groups = c_row_groups(handle) + check_groups(groups, colors, o.index_base) + end + + # -- structural validity, from the pattern alone ------------------------- + if o.partition == SMC_COLUMN + colors = c_column_colors(handle, n)[2] + if o.structure == SMC_NONSYMMETRIC + check_column_disjointness(S, colors) + check_direct_recoverability(S, nothing, colors) + else + check_proper_coloring(S, colors) + if o.decompression == SMC_DIRECT + check_star_coloring(S, colors) + check_symmetric_recoverability(S, colors) + else + check_acyclic_coloring(S, colors) + end + end + elseif o.partition == SMC_ROW + colors = c_row_colors(handle, m)[2] + check_row_disjointness(S, colors) + check_direct_recoverability(S, colors, nothing) + else + rows = c_row_colors(handle, m)[2] + columns = c_column_colors(handle, n)[2] + @test length(rows) == m && length(columns) == n + if o.decompression == SMC_DIRECT + check_direct_recoverability(S, rows, columns) + end + end + + # -- number of colors is what the sizes say ------------------------------ + ret, dims = c_compressed_size(handle) + @test ret == 0 + br_rows, br_cols, bc_rows, bc_cols = dims + if o.partition == SMC_COLUMN + @test (br_rows, br_cols) == (0, 0) + @test (bc_rows, bc_cols) == (m, nc) + elseif o.partition == SMC_ROW + @test (br_rows, br_cols) == (0, 0) + @test (bc_rows, bc_cols) == (nc, n) + else + @test (br_rows, br_cols) == (c_nrow_groups(handle)[2], n) + @test (bc_rows, bc_cols) == (m, c_ncolumn_groups(handle)[2]) + @test br_rows + bc_cols == nc + end + finally + @test c_result_free(handle) == 0 + end +end + +# 3. compress -> decompress round trip + +""" + reference_compression(S, T, partition, row_groups, column_groups, base, dims) + +The compressed matrix is the sum of the columns (resp. rows) of each group. +The groups are the ones the C API reports, so this cross-checks `smc_compress` +against `smc_column_group`. +""" +function reference_compression( + S::SparseMatrixCSC, + ::Type{T}, + partition, + row_groups_, + column_groups_, + base::Integer, + dims, +) where {T} + A = Matrix{T}(S) + br_rows, br_cols, bc_rows, bc_cols = dims + Br = zeros(T, br_rows, br_cols) + Bc = zeros(T, bc_rows, bc_cols) + compress_rows!(B) = + for (g, members) in enumerate(row_groups_), i in members + B[g, :] .+= A[i - base + 1, :] + end + compress_columns!(B) = + for (g, members) in enumerate(column_groups_), j in members + B[:, g] .+= A[:, j - base + 1] + end + if partition == SMC_COLUMN + compress_columns!(Bc) + elseif partition == SMC_ROW + compress_rows!(Bc) + else + compress_rows!(Br) + compress_columns!(Bc) + end + return Br, Bc +end + +function test_roundtrip(S, o) + m, n = size(S) + T = value_type(o.dtype) + handle = c_coloring_ok(S, o) + try + ret, dims = c_compressed_size(handle) + @test ret == 0 + + nzval = Vector{T}(nonzeros(S)) + ret, Br, Bc = c_compress(handle, nzval, dims) + @test ret == 0 + @test !any(==(T(SENTINEL)), Br) + @test !any(==(T(SENTINEL)), Bc) + + # compress must agree with the definition, on the API's own groups. + rgroups = o.partition == SMC_COLUMN ? nothing : c_row_groups(handle) + cgroups = o.partition == SMC_ROW ? nothing : c_column_groups(handle) + Br_ref, Bc_ref = reference_compression( + S, T, o.partition, rgroups, cgroups, o.index_base, dims + ) + @test Br == Br_ref + @test Bc == Bc_ref + + ret, A = c_decompress(handle, Br, Bc, m, n) + @test ret == 0 + @test !any(==(T(SENTINEL)), A) + if o.decompression == SMC_DIRECT + @test A == Matrix{T}(S) # exact: integer data + else + @test A ≈ Matrix{T}(S) atol = 1000 * eps(T) * maximum(abs, S) + end + finally + @test c_result_free(handle) == 0 + end +end + +# 3b. Sizing queries and buffer lengths. Every buffer carries its length as an +# element count, checked before a single element is read or written; `smc_nnz` +# and `smc_size` are the only way a caller holding just a handle can size +# `nzval` and `A_out`. + +function test_sizing_queries(S, o) + m, n = size(S) + handle = c_coloring_ok(S, o) + nullptr = Ptr{Cvoid}(C_NULL) + scratch = Ref(Cint(-1)) + try + @test c_nnz(handle) == (0, nnz(S)) + @test c_size(handle) == (0, (m, n)) + + # A NULL out-pointer is an invalid argument, not a request to skip. + @test Int(ccallable_call(LibSMC.smc_nnz, handle, nullptr)) == -3 + @test Int(ccallable_call(LibSMC.smc_size, handle, nullptr, scratch)) == -3 + @test Int(ccallable_call(LibSMC.smc_size, handle, scratch, nullptr)) == -3 + finally + @test c_result_free(handle) == 0 + end + # A freed handle answers -4, like every other query. + @test c_nnz(handle)[1] == -4 + @test c_size(handle)[1] == -4 +end + +function test_buffer_lengths(S, o) + m, n = size(S) + T = value_type(o.dtype) + bidirectional = o.partition == SMC_BIDIRECTIONAL + handle = c_coloring_ok(S, o) + try + ret, dims = c_compressed_size(handle) + @test ret == 0 + br_len = dims[1] * dims[2] + bc_len = dims[3] * dims[4] + a_len = m * n + nzval = Vector{T}(nonzeros(S)) + + # The queries really are the required lengths. + @test c_nnz(handle)[2] == length(nzval) + @test c_size(handle)[2] == (m, n) + + # -- exactly the announced sizes are enough ----------------------------- + ret, Br, Bc = c_compress( + handle, nzval, dims; nzval_len=length(nzval), Br_len=br_len, Bc_len=bc_len + ) + @test ret == 0 + @test c_decompress( + handle, Br, Bc, m, n; Br_len=br_len, Bc_len=bc_len, A_len=a_len + )[1] == 0 + + # -- one element short, one length at a time ---------------------------- + # Each buffer keeps its full size; only the announced length shrinks, so a + # surviving sentinel proves the check ran before any element was written. + untouched(B) = all(==(T(SENTINEL)), B) + + ret, Br_s, Bc_s = c_compress(handle, nzval, dims; nzval_len=length(nzval) - 1) + @test ret == -3 + @test untouched(Br_s) && untouched(Bc_s) + + ret, Br_s, Bc_s = c_compress(handle, nzval, dims; Bc_len=bc_len - 1) + @test ret == -3 + @test untouched(Br_s) && untouched(Bc_s) + + if bidirectional + ret, Br_s, Bc_s = c_compress(handle, nzval, dims; Br_len=br_len - 1) + @test ret == -3 + @test untouched(Br_s) && untouched(Bc_s) + end + + ret, A = c_decompress(handle, Br, Bc, m, n; A_len=a_len - 1) + @test ret == -3 + @test untouched(A) + + ret, A = c_decompress(handle, Br, Bc, m, n; Bc_len=bc_len - 1) + @test ret == -3 + @test untouched(A) + + if bidirectional + ret, A = c_decompress(handle, Br, Bc, m, n; Br_len=br_len - 1) + @test ret == -3 + @test untouched(A) + end + + # -- a length of zero is short for every buffer that is actually used ---- + @test c_compress(handle, nzval, dims; nzval_len=0)[1] == -3 + @test c_compress(handle, nzval, dims; Bc_len=0)[1] == -3 + @test c_decompress(handle, Br, Bc, m, n; A_len=0)[1] == -3 + @test c_decompress(handle, Br, Bc, m, n; Bc_len=0)[1] == -3 + if bidirectional + @test c_compress(handle, nzval, dims; Br_len=0)[1] == -3 + @test c_decompress(handle, Br, Bc, m, n; Br_len=0)[1] == -3 + end + + # -- a huge length must not wrap into "too small" ----------------------- + # The comparisons are unsigned, so SIZE_MAX must be accepted as a generous + # promise, and only the required elements written. + huge = typemax(Csize_t) + big_br = bidirectional ? huge : Csize_t(0) + @test c_compress( + handle, nzval, dims; nzval_len=huge, Br_len=big_br, Bc_len=huge + )[1] == 0 + @test c_decompress(handle, Br, Bc, m, n; Br_len=big_br, Bc_len=huge, A_len=huge)[1] == + 0 + + # -- NULL buffers ------------------------------------------------------- + ret, A = c_decompress(handle, Br, Bc, m, n; A_null=true) + @test ret == -3 + @test untouched(A) + @test c_compress(handle, nzval, dims; nzval_null=true)[1] == -3 + @test c_compress(handle, nzval, dims; Bc_null=true)[1] == -3 + ret, A = c_decompress(handle, Br, Bc, m, n; Bc_null=true) + @test ret == -3 + @test untouched(A) + + if bidirectional + # Both compressed matrices are required. + @test c_compress(handle, nzval, dims; Br_null=true, Br_len=0)[1] == -3 + ret, A = c_decompress(handle, Br, Bc, m, n; Br_null=true, Br_len=0) + @test ret == -3 + @test untouched(A) + else + # Br is unused: NULL with a length of 0 is the documented call. + @test c_compress(handle, nzval, dims; Br_null=true, Br_len=0)[1] == 0 + @test c_decompress(handle, Br, Bc, m, n; Br_null=true, Br_len=0)[1] == 0 + end + finally + @test c_result_free(handle) == 0 + end +end + +# 4. fast_coloring + +function test_fast_coloring(S, o) + m, n = size(S) + ret, rows, columns, nc = c_fast_coloring(S, o) + @test ret == 0 + reference = reference_result(S, o) + @test nc == ncolors(reference) + o.partition == SMC_ROW || @test columns == column_colors(reference) + o.partition == SMC_COLUMN || @test rows == row_colors(reference) + + # A buffer may be NULL exactly when the partition colors no such dimension. + ret_no_row = c_fast_coloring(S, o; row_buffer=false)[1] + ret_no_col = c_fast_coloring(S, o; column_buffer=false)[1] + @test ret_no_row == (o.partition == SMC_COLUMN ? 0 : -3) + @test ret_no_col == (o.partition == SMC_ROW ? 0 : -3) + + # A NULL ncolors_out is an invalid argument. + colptr, rowval = csc_arrays(S, o.index_base) + opts = Ref(options_struct(o)) + nullptr = Ptr{Cvoid}(C_NULL) + @test Int( + ccallable_call( + LibSMC.smc_fast_coloring, + m, + n, + colptr, + rowval, + opts, + fill(Cint(0), m), + fill(Cint(0), n), + nullptr, + ), + ) == -3 +end + +# 5. index_base + +function test_index_base(S, o) + m, n = size(S) + base0 = merge(o, (index_base=Cint(0),)) + base1 = merge(o, (index_base=Cint(1),)) + + h0 = c_coloring_ok(S, base0) + h1 = c_coloring_ok(S, base1) + try + @test c_ncolors(h0) == c_ncolors(h1) + if o.partition != SMC_ROW + @test c_column_colors(h0, n) == c_column_colors(h1, n) # colors are labels + g0 = c_column_groups(h0) + g1 = c_column_groups(h1) + @test [g .+ 1 for g in g0] == g1 # members shift + end + if o.partition != SMC_COLUMN + @test c_row_colors(h0, m) == c_row_colors(h1, m) + @test [g .+ 1 for g in c_row_groups(h0)] == c_row_groups(h1) + end + + # compression and decompression are unaffected by the index base + _, dims = c_compressed_size(h0) + @test c_compressed_size(h1)[2] == dims + nzval = Vector{Float64}(nonzeros(S)) + _, Br0, Bc0 = c_compress(h0, nzval, dims) + _, Br1, Bc1 = c_compress(h1, nzval, dims) + @test Br0 == Br1 + @test Bc0 == Bc1 + @test c_decompress(h0, Br0, Bc0, m, n)[2] == c_decompress(h1, Br1, Bc1, m, n)[2] + finally + @test c_result_free(h0) == 0 + @test c_result_free(h1) == 0 + end +end + +# 6. symmetric_pattern shortcut + +function test_symmetric_pattern() + S = A_SYM + m, n = size(S) + plain = options() + asserted = options(; symmetric_pattern=1) + h0 = c_coloring_ok(S, plain) + h1 = c_coloring_ok(S, asserted) + try + @test c_column_colors(h0, n) == c_column_colors(h1, n) + @test c_ncolors(h0) == c_ncolors(h1) + finally + @test c_result_free(h0) == 0 + @test c_result_free(h1) == 0 + end +end + +# 7. Several live handles at once. Results live in nine typed stores keyed by +# structure*16 + partition*4 + decompression*2 + dtype; keeping one handle of +# every kind alive checks that the key routes each query back to its own result. + +function test_many_handles() + live = Tuple{Ptr{Cvoid},SparseMatrixCSC,NamedTuple}[] + for (structure, partition, decompression) in SUPPORTED_COMBOS, + dtype in (SMC_FLOAT64, SMC_FLOAT32) + + o = options(; structure, partition, decompression, dtype) + S = first(matrices_for(structure)) + push!(live, (c_coloring_ok(S, o), S, o)) + end + handles = [h for (h, _, _) in live] + @test length(unique(handles)) == length(handles) + + for (handle, S, o) in live + @test c_ncolors(handle)[2] == ncolors(reference_result(S, o)) + _, dims = c_compressed_size(handle) + T = value_type(o.dtype) + ret, Br, Bc = c_compress(handle, Vector{T}(nonzeros(S)), dims) + @test ret == 0 + @test c_decompress(handle, Br, Bc, size(S)...)[1] == 0 + end + + for handle in handles + @test c_result_free(handle) == 0 + end + for handle in handles + @test c_result_free(handle) == -4 + end +end + +# 8. Error paths + +function test_unsupported_combos() + S = A_SYM + for (structure, partition, decompression) in UNSUPPORTED_COMBOS, + dtype in (SMC_FLOAT64, SMC_FLOAT32) + + o = options(; structure, partition, decompression, dtype) + ret, handle = c_coloring(S, o) + @test ret == -2 + @test handle == C_NULL + ret2, _, _, _ = c_fast_coloring(S, o) + @test ret2 == -2 + end +end + +function test_invalid_arguments() + S = A_NONSYM + m, n = size(S) + colptr, rowval = csc_arrays(S, 0) + opts = Ref(options_struct(options())) + handle = Ref(Ptr{Cvoid}(C_NULL)) + nullptr = Ptr{Cvoid}(C_NULL) + + call(args...) = Int(ccallable_call(LibSMC.smc_coloring, args...)) + + @test call(m, n, nullptr, rowval, opts, handle) == -3 # NULL colptr + @test call(m, n, colptr, nullptr, opts, handle) == -3 # NULL rowval + @test call(m, n, colptr, rowval, opts, nullptr) == -3 # NULL result_out + @test call(0, n, colptr, rowval, opts, handle) == -3 # m == 0 + @test call(m, -1, colptr, rowval, opts, handle) == -3 # n < 0 + @test handle[] == C_NULL + + for bad in ( + options(; index_base=2), + options(; index_base=-1), + options(; structure=5), + options(; partition=9), + options(; decompression=7), + options(; order=9), + options(; order=-1), + options(; dtype=4), + ) + ret, h = c_coloring(S, bad) + @test ret == -3 + @test h == C_NULL + end + + # A NULL options pointer selects the defaults (documented in the examples). + ret = call(m, n, colptr, rowval, nullptr, handle) + @test ret == 0 + @test handle[] != C_NULL + @test c_result_free(handle[]) == 0 +end + +function test_short_buffers() + S = A_NONSYM + m, n = size(S) + handle = c_coloring_ok(S, options()) + nullptr = Ptr{Cvoid}(C_NULL) + try + @test c_column_colors(handle, n - 1)[1] == -3 + @test Int(ccallable_call(LibSMC.smc_column_colors, handle, nullptr, n)) == -3 + @test Int(ccallable_call(LibSMC.smc_ncolors, handle, nullptr)) == -3 + @test Int(ccallable_call(LibSMC.smc_ncolumn_groups, handle, nullptr)) == -3 + + _, ngroups = c_ncolumn_groups(handle) + _, size1 = c_group_size(LibSMC.smc_column_group_size, handle, 1) + @test c_group(LibSMC.smc_column_group, handle, 1, size1 - 1)[1] == -3 + @test c_group_size(LibSMC.smc_column_group_size, handle, 0)[1] == -3 + @test c_group_size(LibSMC.smc_column_group_size, handle, ngroups + 1)[1] == -3 + @test c_group(LibSMC.smc_column_group, handle, ngroups + 1, size1)[1] == -3 + + # A column partition has no row information (smc.h: -2, not -3). + @test c_row_colors(handle, m)[1] == -2 + @test c_nrow_groups(handle)[1] == -2 + @test c_group_size(LibSMC.smc_row_group_size, handle, 1)[1] == -2 + + # Lengths are element counts of the dtype, and follow their buffer. + _, dims = c_compressed_size(handle) + nzval = Vector{Float64}(nonzeros(S)) + @test Int( + ccallable_call(LibSMC.smc_compress, handle, nullptr, 0, nullptr, 0, nullptr, 0) + ) == -3 + _, Br, Bc = c_compress(handle, nzval, dims) + @test Int( + ccallable_call( + LibSMC.smc_decompress, handle, nullptr, 0, Bc, length(Bc), nullptr, 0 + ), + ) == -3 + @test Int( + ccallable_call( + LibSMC.smc_compressed_size, handle, nullptr, nullptr, nullptr, nullptr + ), + ) == -3 + @test Int(ccallable_call(LibSMC.smc_nnz, handle, nullptr)) == -3 + finally + @test c_result_free(handle) == 0 + end +end + +function test_invalid_handle() + S = A_NONSYM + m, n = size(S) + handle = c_coloring_ok(S, options()) + _, dims = c_compressed_size(handle) + nzval = Vector{Float64}(nonzeros(S)) + _, Br, Bc = c_compress(handle, nzval, dims) + + @test c_result_free(handle) == 0 + # Every entry point must reject the stale handle with -4 instead of crashing. + @test c_result_free(handle) == -4 # double free + @test c_ncolors(handle)[1] == -4 + @test c_column_colors(handle, n)[1] == -4 + @test c_row_colors(handle, m)[1] == -4 + @test c_ncolumn_groups(handle)[1] == -4 + @test c_nrow_groups(handle)[1] == -4 + @test c_group_size(LibSMC.smc_column_group_size, handle, 1)[1] == -4 + @test c_group(LibSMC.smc_column_group, handle, 1, n)[1] == -4 + @test c_group_size(LibSMC.smc_row_group_size, handle, 1)[1] == -4 + @test c_group(LibSMC.smc_row_group, handle, 1, m)[1] == -4 + @test c_compressed_size(handle)[1] == -4 + @test c_nnz(handle)[1] == -4 + @test c_size(handle)[1] == -4 + @test c_compress(handle, nzval, dims)[1] == -4 + @test c_decompress(handle, Br, Bc, m, n)[1] == -4 + + # An address that was never a handle is rejected the same way. + bogus = Ptr{Cvoid}(UInt(0xdeadbeef0)) + @test c_result_free(bogus) == -4 + @test c_ncolors(bogus)[1] == -4 + @test c_nnz(bogus)[1] == -4 + @test c_size(bogus)[1] == -4 +end + +# 9. Pattern validation. `_check_pattern` is the only input validator in the +# shim, and its rejections are reachable only through a malformed CSC pattern. +# `colptr[n+1]` is the *only* bound on how far `rowval` is read, since the API +# takes no nnz argument. + +"`smc_coloring` on a raw (colptr, rowval) pair; frees the handle on success." +function c_coloring_raw(m, n, colptr::Vector{Cint}, rowval::Vector{Cint}, o) + opts = Ref(options_struct(o)) + handle = Ref(Ptr{Cvoid}(C_NULL)) + ret = Int(ccallable_call(LibSMC.smc_coloring, m, n, colptr, rowval, opts, handle)) + created = handle[] + ret == 0 && created != C_NULL && c_result_free(created) + return ret, created +end + +"`smc_fast_coloring` on a raw (colptr, rowval) pair." +function c_fast_coloring_raw(m, n, colptr::Vector{Cint}, rowval::Vector{Cint}, o) + opts = Ref(options_struct(o)) + nc = Ref(Cint(-1)) + return Int( + ccallable_call( + LibSMC.smc_fast_coloring, + m, + n, + colptr, + rowval, + opts, + fill(Cint(-999), m), + fill(Cint(-999), n), + nc, + ), + ) +end + +"Both entry points must reject the same malformed pattern, and create no handle." +function check_rejected(m, n, colptr, rowval, o) + ret, handle = c_coloring_raw(m, n, colptr, rowval, o) + @test ret == -3 + @test handle == C_NULL + @test c_fast_coloring_raw(m, n, colptr, rowval, o) == -3 +end + +function test_pattern_validation() + base0 = options() + base1 = options(; index_base=1) + + # Reference: a well-formed 3x3 diagonal pattern is accepted in either base. + @test c_coloring_raw(3, 3, Cint[0, 1, 2, 3], Cint[0, 1, 2], base0)[1] == 0 + @test c_coloring_raw(3, 3, Cint[1, 2, 3, 4], Cint[1, 2, 3], base1)[1] == 0 + @test c_fast_coloring_raw(3, 3, Cint[0, 1, 2, 3], Cint[0, 1, 2], base0) == 0 + + # (1) colptr[0] must be exactly the index base. + check_rejected(3, 3, Cint[1, 2, 3, 4], Cint[0, 1, 2], base0) + check_rejected(3, 3, Cint[0, 1, 2, 3], Cint[1, 2, 3], base1) + + # (2) colptr must be non-decreasing; the validator stops at the first decrease. + check_rejected(3, 3, Cint[0, 3, 1, 3], Cint[0, 1, 2], base0) + check_rejected(3, 3, Cint[1, 4, 2, 4], Cint[1, 2, 3], base1) + + # (3) every row index must land inside 1..m once the base is removed. + check_rejected(3, 3, Cint[0, 1, 2, 3], Cint[0, 1, 3], base0) # i == m + check_rejected(3, 3, Cint[0, 1, 2, 3], Cint[0, 1, -1], base0) # i < base + check_rejected(3, 3, Cint[1, 2, 3, 4], Cint[1, 2, 4], base1) # i == m+1 + check_rejected(3, 3, Cint[1, 2, 3, 4], Cint[1, 2, 0], base1) # i < base + + # (4) a duplicate-free CSC pattern holds at most m*n entries, and a colptr[n] + # claiming more is rejected *before* `rowval` is read: without that bound the + # calls below would walk 10 entries off the end of a length-2 `rowval`. + check_rejected(2, 2, Cint[0, 0, 10], Cint[0, 0], base0) + return check_rejected(2, 2, Cint[1, 1, 11], Cint[1, 1], base1) +end + +@testset "libsmc C interface" begin + # `@export_sig` is a hand-written copy of each `@ccallable` signature and + # generate_header.jl emits the C prototypes from it: drift there misdeclares + # the ABI, and nothing else in the pipeline would notice. + @testset "@export_sig matches the @ccallable methods" begin + c_to_julia = Dict( + "int" => Cint, + "int*" => Ptr{Cint}, + "const int*" => Ptr{Cint}, + "size_t" => Csize_t, + "void*" => Ptr{Cvoid}, + "const void*" => Ptr{Cvoid}, + "void**" => Ptr{Ptr{Cvoid}}, + "const SmcColoringOptions*" => Ptr{Cvoid}, + ) + for (name, _, args) in LibSMC.function_sigs + f = getglobal(LibSMC, Symbol(name)) + ms = collect(methods(f)) + @test length(ms) == 1 + julia_args = collect(Base.unwrap_unionall(only(ms).sig).parameters)[2:end] + @test length(julia_args) == length(args) + if length(julia_args) == length(args) + for (i, (argname, ctype)) in enumerate(args) + expected = get(c_to_julia, ctype, nothing) + expected === nothing && continue + @test julia_args[i] === expected + end + end + end + end + + @testset "options and version" begin + test_options() + test_version() + end + + @testset "coloring $(structure)/$(partition)/$(decompression)" for ( + structure, partition, decompression + ) in SUPPORTED_COMBOS + + @testset "order $order, postprocessing $post, dtype $dtype" for order in ALL_ORDERS, + post in (0, 1), + dtype in (SMC_FLOAT64, SMC_FLOAT32) + + o = options(; + structure, partition, decompression, order, postprocessing=post, dtype + ) + for S in matrices_for(structure) + test_coloring(S, o) + test_roundtrip(S, o) + test_fast_coloring(S, o) + end + end + + @testset "index_base" begin + o = options(; structure, partition, decompression) + for S in matrices_for(structure) + test_index_base(S, o) + end + end + end + + @testset "sizing queries and buffer lengths" begin + @testset "$(structure)/$(partition)/$(decompression), dtype $dtype" for ( + structure, partition, decompression + ) in SUPPORTED_COMBOS, + dtype in (SMC_FLOAT64, SMC_FLOAT32) + + o = options(; structure, partition, decompression, dtype) + for S in matrices_for(structure) + test_sizing_queries(S, o) + test_buffer_lengths(S, o) + end + end + end + + @testset "symmetric_pattern" begin + test_symmetric_pattern() + end + + @testset "several live handles" begin + test_many_handles() + end + + @testset "errors: unsupported combinations" begin + test_unsupported_combos() + end + + @testset "errors: invalid arguments" begin + test_invalid_arguments() + end + + @testset "errors: short and NULL buffers" begin + test_short_buffers() + end + + @testset "errors: invalid and freed handles" begin + test_invalid_handle() + end + + @testset "errors: malformed CSC patterns" begin + test_pattern_validation() + end +end diff --git a/test/static_compilation.jl b/test/static_compilation.jl index dbc6005b..e053ffe8 100644 --- a/test/static_compilation.jl +++ b/test/static_compilation.jl @@ -1,8 +1,5 @@ -# Guard for static compilation (`juliac --trim=safe`). -# -# The C and Fortran interfaces compile SMC.jl into a standalone shared library. -# The trimming verifier rejects any call whose result type is not fully inferred, -# so `coloring` must return a concrete type. +# Guard for static compilation: `juliac --trim=safe` rejects any call whose +# result type is not fully inferred. using SparseArrays using SparseMatrixColorings