diff --git a/.github/workflows/release-libsmc.yml b/.github/workflows/release-libsmc.yml new file mode 100644 index 00000000..a0004cf7 --- /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 + # interfaces/DESIGN.md section 0. + # ----------------------------------------------------------------------- + - 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..fb712641 --- /dev/null +++ b/.github/workflows/test-libsmc.yml @@ -0,0 +1,498 @@ +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 }}" + ls -l interfaces/build/test_smc_fortran* + + - 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 if the program + # dies the tail of the log is lost and the failure looks like it + # happened earlier than it did. Unbuffered output makes the last line + # printed the real location of the failure. + export GFORTRAN_UNBUFFERED_ALL=1 + # Windows-only, and temporary: the suite dies mid-run there with a + # status no other platform produces, and a crash inside the library + # leaves no FAIL line, so the section headers only narrow it to a + # subroutine. Echoing every check makes the last line printed the + # exact call that was reached. Drop this once the cause is known. + if [ "${{ runner.os }}" = "Windows" ]; then + export SMC_TEST_VERBOSE=1 + fi + set +e + interfaces/build/test_smc_fortran + rc=$? + set -e + # Report the raw status: 127 means bash could not exec the binary at + # all (missing file or unresolved DLL), which is a different problem + # from the program running and then dying. + echo "test_smc_fortran exited with $rc" + exit $rc + + # ---- 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/examples/C/basic_coloring.c b/interfaces/examples/C/basic_coloring.c new file mode 100644 index 00000000..d984297a --- /dev/null +++ b/interfaces/examples/C/basic_coloring.c @@ -0,0 +1,191 @@ +/* + * 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, so that the corresponding + * columns of a Jacobian can be recovered from a single directional derivative. + * Only the *sparsity pattern* is needed here: smc_coloring never looks at the + * numerical values (see compress_decompress.c for the 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 makes the executable find the bundle without LD_LIBRARY_PATH: it + * assumes the binary sits in interfaces/build/, next to lib/. The library then + * locates the embedded Julia runtime through its own runpath. On macOS use + * -Wl,-rpath,@loader_path/lib instead ($ORIGIN is a Linux spelling). + * + * 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" + +/* ------------------------------------------------------------------------- + * Problem data: A = tridiag(-1, 2, -1), 6x6, in compressed sparse column form. + * + * With opts.index_base == 0 (the default) both colptr and rowval are 0-based, + * exactly like a C array: + * + * column j occupies the entries colptr[j] .. colptr[j+1] - 1 + * rowval[k] is the 0-based row index of entry k + * + * Column 0 touches rows {0,1}, column 1 rows {0,1,2}, and so on. + * ------------------------------------------------------------------------- */ + +#define M 6 /* number of rows */ +#define N 6 /* number of columns */ +#define NNZ 16 /* number of stored entries */ + +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 }; + +/* ------------------------------------------------------------------------- + * main + * ------------------------------------------------------------------------- */ + +int main(void) +{ + int major, minor, patch; + smc_version(&major, &minor, &patch); + printf("SparseMatrixColorings %d.%d.%d\n", major, minor, patch); + + /* ----------------------------------------------------------------------- + * Options. smc_default_options() gives: + * structure = SMC_NONSYMMETRIC + * partition = SMC_COLUMN + * decompression = SMC_DIRECT + * order = SMC_NATURAL + * index_base = 0 + * dtype = SMC_FLOAT64 + * which is exactly what we want here, so we do not override anything. + * --------------------------------------------------------------------- */ + SmcColoringOptions opts = smc_default_options(); + + /* ----------------------------------------------------------------------- + * Compute the coloring. 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; + } + + /* ----------------------------------------------------------------------- + * Number of colors. + * --------------------------------------------------------------------- */ + 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); + + /* ----------------------------------------------------------------------- + * Per-column colors. The buffer is caller-allocated and must hold at least + * n entries. Colors are integers in 1..ncolors; the value 0 is the neutral + * color, which only appears when opts.postprocessing is enabled and marks a + * column that needs no directional derivative at all. + * + * Note that colors are labels, not indices: they are unaffected by + * opts.index_base. + * --------------------------------------------------------------------- */ + 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 information seen the other way round: the groups of columns that + * share a color. Group indices run over 1..ncolumn_groups; the members are + * column indices written in the caller's index base (0-based here). + * + * Sizes are queried first so the caller can size its 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); + } + + /* ----------------------------------------------------------------------- + * Release the handle. Using it after this point returns -4 (invalid or + * already-freed handle) 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..c2e492a4 --- /dev/null +++ b/interfaces/examples/C/compress_decompress.c @@ -0,0 +1,280 @@ +/* + * compress_decompress.c — the full round trip: color, compress, decompress. + * + * This is the workflow a Jacobian/Hessian code actually uses: + * + * 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) + * + * Here step 2 is done by the library itself (smc_compress sums the columns of A + * that share a color), which lets us check that decompress(compress(A)) == A. + * + * A = tridiag(-1, 2, -1), 6x6, so three colors suffice and the compressed + * matrix is 6x3 instead of 6x6 — a 2x saving on derivative evaluations. + * + * This example is also the reference for the buffer-length discipline of the + * API. Every numerical buffer is passed together with its length in elements, + * and every 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 required 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 + * + * The rpath assumes the binary sits in interfaces/build/, next to lib/; 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" + +/* ------------------------------------------------------------------------- + * Problem data: A = tridiag(-1, 2, -1), 6x6, compressed sparse column, 0-based. + * + * nzval follows exactly the same ordering as rowval: nzval[k] is the value of + * the entry stored at row rowval[k]. + * ------------------------------------------------------------------------- */ + +#define M 6 /* number of rows */ +#define N 6 /* number of columns */ +#define NNZ 16 /* number of stored entries */ + +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 }; + +/* ------------------------------------------------------------------------- + * main + * ------------------------------------------------------------------------- */ + +int main(void) +{ + /* Defaults: nonsymmetric / column / direct / natural, 0-based, Float64. + dtype is what fixes the element type of the compressed and decompressed + buffers below: SMC_FLOAT64 means double, SMC_FLOAT32 would mean float. + It also fixes the unit of every *_len argument, which counts elements of + that type — never bytes. */ + 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. A caller that + * received the handle from elsewhere and has none of the CSC arrays at hand + * can still do this: the result remembers the pattern it was built from. + * + * smc_nnz : length nzval must have in smc_compress + * smc_size : the m and n of that pattern, so A_out must hold m*n elements + * --------------------------------------------------------------------- */ + 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); + + /* Our static data must match what the handle reports, or the lengths we are + about to pass would be a lie. */ + if (m != M || n != N || nnz != NNZ) { + fprintf(stderr, "handle describes a different pattern\n"); + smc_result_free(result); + return 1; + } + + /* ----------------------------------------------------------------------- + * Shape of the compressed matrix. + * + * With a bidirectional partition the compression is split in two blocks, 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 we pass + * NULL wherever Br is expected — with a length of 0 to match. + * --------------------------------------------------------------------- */ + 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; + } + + /* Bc is m-by-ncolors for a column partition. Compute the element counts in + size_t: m*n overflows a 32-bit int for 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. + * + * Each buffer is followed by its length in elements. Br is unused by a + * column partition, so it is NULL with length 0. + * --------------------------------------------------------------------- */ + 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 matrix A from B, again + * column-major (A[i,j] is Ad[i + j*m]). + * --------------------------------------------------------------------- */ + 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 1: every stored entry of A came back exactly. + * Check 2: 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); + + /* ----------------------------------------------------------------------- + * The lengths are not decoration. Understating any of them is refused with + * -3, and the library reads and writes nothing before it refuses — which is + * exactly the guarantee that lets a caller reuse a handle 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..f68f8319 --- /dev/null +++ b/interfaces/examples/C/symmetric_coloring.c @@ -0,0 +1,156 @@ +/* + * symmetric_coloring.c — color a symmetric matrix (Hessian-style). + * + * A is the 2D 5-point Laplacian on a 4x4 grid: a 16x16 symmetric matrix with + * 4 on the diagonal and -1 for each of the (up to four) grid neighbours. + * + * The difference with basic_coloring.c is opts.structure = SMC_SYMMETRIC. A + * symmetric coloring exploits the fact that A[i,j] can be read off either from + * column j or from column i, so it needs strictly fewer colors than treating + * the matrix as a general nonsymmetric one. Combined with SMC_DIRECT it + * computes a *star coloring* and every entry is recovered by a plain copy (no + * triangular solve — that would be SMC_SUBSTITUTION). + * + * 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' + * + * The rpath assumes the binary sits in interfaces/build/, next to 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" + +/* ------------------------------------------------------------------------- + * Grid and matrix sizes + * ------------------------------------------------------------------------- */ + +#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 compressed sparse column form (0-based). + * + * The matrix is symmetric, so column k holds the same indices as row k: + * k-NX (south), k-1 (west), k (centre), k+1 (east), k+NX (north) + * which is already sorted in increasing order, as CSC requires. + * + * Returns the number of stored entries. + * ------------------------------------------------------------------------- */ +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; +} + +/* ------------------------------------------------------------------------- + * main + * ------------------------------------------------------------------------- */ + +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); + + /* ----------------------------------------------------------------------- + * Options: symmetric structure, direct decompression. + * + * symmetric_pattern = 1 asserts that the pattern really is symmetric, which + * lets the library skip building the transposed pattern. Setting it on a + * non-symmetric pattern is a promise the library trusts, so only do it when + * it holds — as it does for a Laplacian. + * + * The partition stays SMC_COLUMN: a symmetric problem is colored by columns. + * --------------------------------------------------------------------- */ + 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); + + /* ----------------------------------------------------------------------- + * Print the colors laid out on the grid, which 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..7aeb5c6b --- /dev/null +++ b/interfaces/examples/Fortran/basic_coloring.f90 @@ -0,0 +1,222 @@ +! 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, so that the corresponding +! columns of a Jacobian can be recovered from a single directional derivative. +! Only the *sparsity pattern* is needed here: smc_coloring never looks at the +! numerical values (see compress_decompress.f90 for the values). +! +! This is the Fortran counterpart of examples/C/basic_coloring.c, with one +! deliberate difference: it sets opts%index_base = 1, so that colptr, rowval and +! the group members returned by the queries are all 1-based — Fortran's own +! convention. Color *labels* are never shifted by index_base; only indices are. +! +! 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. +! The rpath makes the executable find the bundle without LD_LIBRARY_PATH: it +! assumes the binary sits in interfaces/build/, next to lib/. The library then +! locates the embedded Julia runtime through its own runpath. On macOS use +! -Wl,-rpath,@loader_path/lib instead ($ORIGIN is a Linux spelling). +! +! 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' ! <- after implicit none; brings in the interfaces, + ! the enumerators and type(SmcColoringOptions) + + ! ------------------------------------------------------------------------- + ! Problem data: A = tridiag(-1, 2, -1), 6x6, in compressed sparse column form. + ! + ! With opts%index_base == 1 both colptr and rowval are 1-based, exactly like a + ! Fortran array: + ! + ! column j occupies the entries colptr(j) .. colptr(j+1) - 1 + ! rowval(k) is the 1-based row index of entry k + ! + ! Column 1 touches rows {1,2}, column 2 rows {1,2,3}, and so on. (The C + ! example uses index_base = 0, the default, and subtracts one everywhere.) + ! + ! Every array whose address is handed to C through c_loc must carry the + ! target attribute — that is what makes taking its address legal, and what + ! stops the compiler from keeping it in a register or copying it. + ! ------------------------------------------------------------------------- + + 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. They are + ! passed as c_loc(...), so they too need the target attribute. + 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 + + ! ------------------------------------------------------------------------- + ! Version of SparseMatrixColorings.jl embedded in the library. smc_version + ! is the one void-returning entry point, hence a subroutine call, and the one + ! whose int* outputs are bound as plain intent(out) scalars rather than + ! type(c_ptr), so no c_loc is needed here. + ! ------------------------------------------------------------------------- + call smc_version(major, minor, patch) + write(*,'(A,I0,A,I0,A,I0)') "SparseMatrixColorings ", major, ".", minor, ".", patch + + ! ------------------------------------------------------------------------- + ! Options. smc_default_options() gives: + ! structure = SMC_NONSYMMETRIC + ! partition = SMC_COLUMN + ! decompression = SMC_DIRECT + ! order = SMC_NATURAL + ! index_base = 0 + ! dtype = SMC_FLOAT64 + ! Always start from that call, then override only the fields you care about — + ! here the index base, so the CSC arrays above can be written the Fortran way. + ! ------------------------------------------------------------------------- + opts = smc_default_options() + opts%index_base = 1 + + ! ------------------------------------------------------------------------- + ! Compute the coloring. The result is an opaque handle owned by the library; + ! it must be released with smc_result_free(). + ! + ! result_out is the one argument that is *not* passed by value: it is the + ! void** out-parameter, declared type(c_ptr), intent(out), so `result` is + ! given bare rather than through c_loc. Everything else is 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 + + ! ------------------------------------------------------------------------- + ! Number of colors. + ! ------------------------------------------------------------------------- + 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 + + ! ------------------------------------------------------------------------- + ! Per-column colors. The buffer is caller-allocated and must hold at least n + ! entries; the length is passed alongside it and checked before a single + ! element is written, so a short buffer is refused with -3 rather than + ! overrun. Colors are integers in 1..ncolors; the value 0 is the neutral + ! color, which only appears when opts%postprocessing is enabled and marks a + ! column that needs no directional derivative at all. + ! + ! Note that colors are labels, not indices: they are unaffected by + ! opts%index_base, and so are indexed 1..n here purely because `colors` is a + ! Fortran array. + ! ------------------------------------------------------------------------- + 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 information seen the other way round: the groups of columns that + ! share a color. Group indices run over 1..ncolumn_groups and are always + ! 1-based, independently of opts%index_base; the *members* are column indices + ! written in the caller's index base, so with index_base = 1 they can be used + ! to subscript a Fortran array directly. + ! + ! Sizes are queried first so the caller can size its buffer exactly. + ! ------------------------------------------------------------------------- + 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 even + ! though a color class is always nonempty in practice. + 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 + + ! ------------------------------------------------------------------------- + ! Release the handle. Using it after this point returns -4 (invalid or + ! already-freed handle) 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..6e433d93 --- /dev/null +++ b/interfaces/examples/Fortran/compress_decompress.f90 @@ -0,0 +1,324 @@ +! compress_decompress.f90 — the full round trip: color, compress, decompress. +! +! This is the workflow a Jacobian/Hessian code actually uses: +! +! 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) +! +! Here step 2 is done by the library itself (smc_compress sums the columns of A +! that share a color), which lets us check that decompress(compress(A)) == A. +! +! A = tridiag(-1, 2, -1), 6x6, so three colors suffice and the compressed +! matrix is 6x3 instead of 6x6 — a 2x saving on derivative evaluations. +! +! This example is also the reference for the buffer-length discipline of the +! API. Every numerical buffer is passed together with its length in elements, +! and every 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 required 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, which is Fortran's +! own layout — so Bc and A below are plain 2D arrays, handed over with a single +! c_loc and indexed Bc(i,j) / A(i,j) with no manual i + j*rows arithmetic. +! +! Like basic_coloring.f90 this sets opts%index_base = 1, so colptr and rowval +! are 1-based and rowval(k) subscripts A directly. +! +! 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. The rpath assumes the +! binary sits in interfaces/build/, next to lib/; 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' ! <- after implicit none + + ! ------------------------------------------------------------------------- + ! Problem data: A = tridiag(-1, 2, -1), 6x6, compressed sparse column, + ! 1-based to match opts%index_base = 1 below. + ! + ! nzval follows exactly the same ordering as rowval: nzval(k) is the value of + ! the entry stored at row rowval(k). Coloring ignores it entirely; 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 + + ! Dense buffers, allocated from the queried sizes and never from a guess. + 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 byte counts, and use c_size_t because + ! m*n overflows a 32-bit int for 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 is what fixes the element type of the compressed and decompressed + ! buffers below: SMC_FLOAT64 means real(c_double), SMC_FLOAT32 would mean + ! real(c_float). It also fixes the unit of every *_len argument, which + ! counts elements of that type — never bytes. + ! ------------------------------------------------------------------------- + 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. A caller that + ! received the handle from elsewhere and has none of the CSC arrays at hand + ! can still do this: the result remembers the pattern it was built from. + ! + ! smc_nnz : length nzval must have in smc_compress + ! smc_size : the m and n of that pattern, so A must hold m*n elements + ! ------------------------------------------------------------------------- + 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" + + ! Our static data must match what the handle reports, or the lengths we are + ! about to pass would be a lie. + 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 + + ! ------------------------------------------------------------------------- + ! Shape of the compressed matrix. + ! + ! With a bidirectional partition the compression is split in two blocks, 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 we pass + ! c_null_ptr wherever Br is expected — with a length of 0 to match. + ! ------------------------------------------------------------------------- + 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 — nothing is hard-coded here. + ! Bc is m-by-ncolors for a column partition. Because Fortran stores arrays + ! column-major, 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. + ! + ! Each buffer is followed by its length in elements. Br is unused by a + ! column partition, so it is c_null_ptr with length 0. + ! ------------------------------------------------------------------------- + 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 matrix A from B. Again the + ! column-major buffer is just a Fortran 2D array, so A(i,j) is the entry the + ! C example has to spell Ad[i + j*m]. + ! ------------------------------------------------------------------------- + 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 1: every stored entry of A came back exactly. + ! Check 2: 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 at all: column j runs over the entries + ! colptr(j) .. colptr(j+1)-1, and rowval(k) subscripts A directly. + ! ------------------------------------------------------------------------- + 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 + + ! ------------------------------------------------------------------------- + ! The lengths are not decoration. Understating any of them is refused with + ! -3, and the library reads and writes nothing before it refuses — which is + ! exactly the guarantee that lets a caller reuse a handle 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 + + ! ------------------------------------------------------------------------- + ! Release the handle; the Fortran arrays are deallocated on the way out. + ! ------------------------------------------------------------------------- + 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, hence nonnegative: > 0 is the exact-equality + ! test, spelled so that no compiler warns 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..9ac295c1 --- /dev/null +++ b/interfaces/include/smc.f90 @@ -0,0 +1,511 @@ +! 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. +! +! Usage: +! Add use iso_c_binding and include 'smc.f90' AFTER implicit none +! in your program or subroutine. +! +! Example: +! +! program my_prog +! use iso_c_binding +! implicit none +! include 'smc.f90' ! <- here, after implicit none +! ... +! end program +! +! This is an include file rather than a module on purpose: no .mod file has +! to be shipped, and any Fortran compiler can consume it. +! +! 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: n+1 column pointers and the + ! row indices of the nonzeros, both 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 color and group + ! buffers use an int len because they are bounded by m or n; the + ! numerical buffers use size_t, since A_len is m*n and overflows a + ! 32-bit int for ordinary dimensions (m = n = 50000 gives 2.5e9). + ! A buffer that is too small 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..134a155a --- /dev/null +++ b/interfaces/include/smc.h @@ -0,0 +1,411 @@ +#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 and never in + * bytes. The numerical buffers of smc_compress and smc_decompress use + * size_t rather than int, because their lengths are products such as m*n. + * ------------------------------------------------------------------------- */ + +/* ------------------------------------------------------------------------- + * 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: n+1 column pointers and the + * row indices of the nonzeros, both 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 color and group + * buffers use an int len because they are bounded by m or n; the + * numerical buffers use size_t, since A_len is m*n and overflows a + * 32-bit int for ordinary dimensions (m = n = 50000 gives 2.5e9). + * A buffer that is too small 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 -- and every length is checked before a + * single element is read or written. + * 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 -- and every length is checked + * before a single element is read or written. + * 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..8e0f2017 --- /dev/null +++ b/interfaces/scripts/coloring_table.jl @@ -0,0 +1,187 @@ +# coloring_table.jl — single source of truth for the libsmc combination tables. +# +# This file is pure data: no `using`, no dependency on SparseMatrixColorings, no +# reference to any type of the package. That is what lets it be loaded by two +# very different consumers: +# +# * `interfaces/src/c_stores.jl` (through `interfaces/src/LibSMC.jl`), which +# needs the enum values and the combo keys that index the typed handle +# stores; +# * `interfaces/scripts/generate_header.jl`, which loads it into a bare +# `Module` — with no package environment at all — to cross-check the +# enumerators it writes into `include/smc.h`. +# +# Everything here is a verbatim transcription of DESIGN.md sections 2 and 3. +# The *values* are part of the ABI: entry `i` of each enum table has the value +# `i - 1`, and those numbers must never move. + +# --------------------------------------------------------------------------- +# Enumerators (DESIGN.md section 2). Each entry is +# (C enumerator, Julia counterpart as it appears in LibSMC.jl) +# and its value is its 0-based position in the table. +# --------------------------------------------------------------------------- + +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 deliberately excluded from v1: it carries an `AbstractRNG`, +# which is untested under `--trim=safe`. Every order below is a singleton, so +# each entry can be written as a literal constructor inside an `if` branch +# (constraint C1 of DESIGN.md section 0). +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` so they can be compared with the fields of +# `SmcColoringOptions` without any promotion. +# --------------------------------------------------------------------------- + +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 (DESIGN.md section 3) +# +# key = structure * 16 + partition * 4 + decompression * 2 + dtype +# +# The key fits in a `UInt8` (largest supported value is 0x13) and is what the +# handle -> key store records, so that every later call can recover the +# concrete type of the result it was given. +# --------------------------------------------------------------------------- + +combo_key(structure, partition, decompression, dtype) = + UInt8(structure * 16 + partition * 4 + decompression * 2 + dtype) + +# 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 key with the `dtype` bit cleared: the three (structure, partition, +# decompression) triples that `smc_fast_coloring` needs, since it 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 of DESIGN.md section 3. +# +# Each entry is +# (store number, store name, [keys routed to it], structure, partition, +# decompression, dtype or "both", concrete value type as measured by +# running Julia on 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. +# `interfaces/src/c_stores.jl` spells the types out again in Julia syntax; this +# table is the reference they are checked against. +# +# `SubArray{...}` below is exactly +# 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. In particular +# `(nonsymmetric, column|row, substitution)` is not a `ColoringProblem` that +# SparseMatrixColorings supports, and neither is any symmetric row or +# bidirectional partition. +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..cb92c449 --- /dev/null +++ b/interfaces/scripts/generate_header.jl @@ -0,0 +1,1068 @@ +#!/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 +# scripts/coloring_table.jl (single source of truth). +# Usage: julia interfaces/scripts/generate_header.jl +# +# Both the C header and the Fortran binding are emitted from the SAME checked +# signature table, so the two can never drift apart: a change to the ABI shows +# up in both files or in neither. +# +# The generator is deliberately dependency-free (no `using SparseMatrixColorings`, +# no TOML stdlib) so that it also runs in a bare environment. When LibSMC.jl or +# coloring_table.jl cannot be loaded it falls back to the built-in tables below, +# which are a verbatim transcription of DESIGN.md sections 2 and 3, and warns. +# The generated header must be identical either way -- CI regenerates it and +# fails on `git diff --exit-code`. + +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")) + +# --------------------------------------------------------------------------- +# SparseMatrixColorings.jl version, parsed straight out of Project.toml so the +# generator does not need the package to be loadable. +# --------------------------------------------------------------------------- +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 + error("no `version = \"...\"` entry found in $path") +end + +const _SV = project_version(PROJECT_TOML_PATH) + +# --------------------------------------------------------------------------- +# Enumerators (DESIGN.md section 2). Each entry is +# (c_type_name, [candidate names in coloring_table.jl], doc, [(name, value)]) +# The values are canonical: they are part of the 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 (DESIGN.md section 2). 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 (DESIGN.md +# section 3). 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 DESIGN.md section 2 by hand; LibSMC.function_sigs wins when available and +# any disagreement is reported. +# 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 -- and every length is checked before a\n" * + "single element is read or written.\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 -- and every length is checked\n" * + "before a single element is read or written.\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: n+1 column pointers and the", + "row indices of the nonzeros, both 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 color and group", + "buffers use an int len because they are bounded by m or n; the", + "numerical buffers use size_t, since A_len is m*n and overflows a", + "32-bit int for ordinary dimensions (m = n = 50000 gives 2.5e9).", + "A buffer that is too small 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 module and its bindings only exist in a newer world + # than this function (Julia >= 1.12 warns otherwise). + 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 exact shape: a 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 = entry isa Pair ? (entry.first, entry.second) : + entry isa Union{Tuple,AbstractVector} ? entry : () + 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, and CI compares it +# byte for byte. A disagreement is reported loudly 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 DESIGN.md for $type_name; keeping the DESIGN.md values" design = 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. Diffing names only used to + # let an arity or type change through with a warning and exit 0: the header + # then declared, say, a 4-argument `smc_compress` for a 7-argument callee, + # and a C caller would pick the missing arguments out of whatever happened + # to be in the argument registers. Nothing else catches this -- the Julia + # test suite builds its calls by reflecting on the Julia methods, so it + # cannot see header drift, and CI's `git diff --exit-code` passes as soon as + # the developer commits the (wrong) regenerated header. + 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 so +# that smc.h and smc.f90 are always two renderings of the same table. +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 + +# A banner comment, as used for the sections of the header. +function emit_banner(io, lines) + println(io, "/* -------------------------------------------------------------------------") + for l in lines + println(io, isempty(l) ? " *" : " * $l") + end + 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;") + 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;") + 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 and never in", + "bytes. The numerical buffers of smc_compress and smc_decompress use", + "size_t rather than int, because their lengths are products such as m*n.", + ]) + 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 = isempty(args) ? "void" : join(["$ctype $aname" for (aname, ctype) in args], ", ") + println(io, "$ret $name($arg_str);") + println(io) + end + + println(io, """ +#ifdef __cplusplus +} +#endif + +#endif /* SMC_H */""") +end + +println("Generated $OUT_PATH") + +# =========================================================================== +# Fortran binding (include/smc.f90) +# +# Emitted from SIGS and ENUM_TABLES, exactly like smc.h above, so the two +# files describe the same ABI by construction. Following Krylov.jl, the +# binding is an INCLUDE FILE rather than a module: users write +# +# use iso_c_binding +# implicit none +# include 'smc.f90' +# +# which avoids shipping compiler-specific .mod files. +# =========================================================================== + +# --------------------------------------------------------------------------- +# C-to-Fortran type mapping for this ABI. 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 receiving a handle. +# +# `smc_version` is bound the way Krylov.jl binds `krylov_get_version`: its three +# `int*` outputs are plain `integer(c_int), intent(out)` scalars, so a caller +# writes `call smc_version(major, minor, patch)` instead of wrapping each one in +# c_loc. 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") + 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") + error("no Fortran mapping for the C return type `$ctype`") +end + +# --------------------------------------------------------------------------- +# Per-function documentation for the Fortran binding. Deliberately shorter +# and Fortran-flavoured (c_loc / c_null_ptr / opts%field) than FUNCTION_DOCS, +# which speaks C. Only the prose differs: the declarations themselves come +# from SIGS, the same table smc.h is generated from. +# --------------------------------------------------------------------------- +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.", +) + +# --------------------------------------------------------------------------- +# Fortran comment emitters +# --------------------------------------------------------------------------- +const F_RULE = "-------------------------------------------------------------------------" + +# The section banners are shared with the C header, where a struct field reads +# `opts->dtype`; Fortran spells the same thing `opts%dtype`. Rewriting is +# preferable to keeping a second copy of the prose, which 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 + println(io, f_comment(indent, F_RULE)) +end + +# Wrap `head(a, b, c)` over several lines, continuing with `&`, so that no line +# exceeds `width` characters. The continuation lines align 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, the dummy argument +# declarations, the result declaration, and the closing `end` statement. +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, exactly + # as a human would write them. + 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 + 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. +! +! Usage: +! Add use iso_c_binding and include 'smc.f90' AFTER implicit none +! in your program or subroutine. +! +! Example: +! +! program my_prog +! use iso_c_binding +! implicit none +! include 'smc.f90' ! <- here, after implicit none +! ... +! end program +! +! This is an include file rather than a module on purpose: no .mod file has +! to be shipped, and any Fortran compiler can consume it. +! +! 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, keeping the per-field + # comments (whose continuation lines 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) + 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..bbf0b515 --- /dev/null +++ b/interfaces/src/LibSMC.jl @@ -0,0 +1,846 @@ +module LibSMC + +using SparseArrays +using SparseMatrixColorings + +# SparseMatrixColorings.jl version compiled into this library (matches the +# SMC_VERSION_* macros in smc.h; queryable at run time via smc_version). +const _SMC_VERSION = pkgversion(SparseMatrixColorings) + +# The enum values and combo keys are shared with the header generator. +include(joinpath(@__DIR__, "..", "scripts", "coloring_table.jl")) +include("c_enums.jl") +include("c_stores.jl") + +# --------------------------------------------------------------------------- +# Function signatures exported to the generated C header. +# Each entry: (c_name, return_type, [(arg_name, c_type), ...]) +# This vector is read by scripts/generate_header.jl. +# --------------------------------------------------------------------------- +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)) + esc(:(nothing)) +end + +# =========================================================================== +# Input validation and pattern conversion +# =========================================================================== + +# Only the twelve combo keys of DESIGN.md section 3 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 + # `nz` comes from the caller's `colptr[n+1]`, and the API takes no `nnz` + # argument, so this loop is the only thing standing between a bad last entry + # and a wild read off the end of `rowval`. A duplicate-free CSC pattern can + # hold at most `m * n` entries; `Int(m) * Int(n)` cannot overflow here because + # both came from a `Cint`. Without this bound, a garbage `colptr[n+1]` either + # segfaults inside the validator or -- worse -- reads a few MB of heap that + # happen to satisfy `1 <= i <= m` and yields a silently wrong coloring. + 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 (DESIGN.md +# section 4, item 4: no `sparse(...)` with COO triplets). The caller's memory +# is 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 + +# =========================================================================== +# Coloring — order dispatch through a function barrier (constraint C1) +# +# A `Union{NaturalOrder,LargestFirst,...}` hoisted into a variable defeats the +# trimmer. `@order_barrier` instead expands to an if/elseif chain in which +# every branch calls the implementation with a *concrete literal* order, so each +# branch gets its own specialization. One implementation per +# (structure, partition, decompression) triple, five call sites each. +# +# Convention: the implementation is called as `impl(A, , rest...)`. +# =========================================================================== + +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 (DESIGN.md section 4, item 6); +# both branches 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 + +_color_ns_col(A, order::Cint, pp::Bool, sp::Bool) = + @order_barrier order _color_ns_col_impl A pp sp + +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 + +_fast_ns_col(A, order::Cint, pp::Bool, sp::Bool) = + @order_barrier order _fast_ns_col_impl A pp sp + +## 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 + +_color_ns_row(A, order::Cint, pp::Bool, sp::Bool) = + @order_barrier order _color_ns_row_impl A pp sp + +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 + +_fast_ns_row(A, order::Cint, pp::Bool, sp::Bool) = + @order_barrier order _fast_ns_row_impl A pp sp + +## 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 + +_color_sym_col_direct(A, order::Cint, pp::Bool, sp::Bool) = + @order_barrier order _color_sym_col_direct_impl A pp sp + +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 + +_fast_sym_col_direct(A, order::Cint, pp::Bool, sp::Bool) = + @order_barrier order _fast_sym_col_direct_impl A pp sp + +## 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; without it the keyword tuple widens + # `Type{R}` to `DataType`, `R` is erased, and `--trim=safe` rejects this call + # with a verifier error. A type assertion on the result does NOT rescue it: + # it narrows downstream of the call, while the verifier rejects the call + # itself. See the comment on `coloring` in src/interface.jl. + return coloring( + A, ColoringProblem{:symmetric,:column}(), algo; + decompression_eltype=R, symmetric_pattern=sp, + ) +end + +_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 + +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 + +_fast_sym_col_subst(A, order::Cint, pp::Bool, sp::Bool) = + @order_barrier order _fast_sym_col_subst_impl A pp sp + +## nonsymmetric / bidirectional / direct + +function _color_ns_bid_direct_impl(A, order, pp::Bool, sp::Bool, ::Type{R}) where {R} + algo = @greedy :direct order pp + # Depends on `coloring` being `@constprop :aggressive` -- see the note on + # `_color_sym_col_subst_impl` above. + return coloring( + A, ColoringProblem{:nonsymmetric,:bidirectional}(), algo; + decompression_eltype=R, symmetric_pattern=sp, + ) +end + +_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 + +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 + +_fast_ns_bid_direct(A, order::Cint, pp::Bool, sp::Bool) = + @order_barrier order _fast_ns_bid_direct_impl A pp sp + +## nonsymmetric / bidirectional / substitution + +function _color_ns_bid_subst_impl(A, order, pp::Bool, sp::Bool, ::Type{R}) where {R} + algo = @greedy :substitution order pp + # Depends on `coloring` being `@constprop :aggressive` -- see the note on + # `_color_sym_col_subst_impl` above. + return coloring( + A, ColoringProblem{:nonsymmetric,:bidirectional}(), algo; + decompression_eltype=R, symmetric_pattern=sp, + ) +end + +_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 + +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 + +_fast_ns_bid_subst(A, order::Cint, pp::Bool, sp::Bool) = + @order_barrier order _fast_ns_bid_subst_impl A pp sp + +# =========================================================================== +# _do_* helpers for the two coloring entry points +# =========================================================================== + +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 the thing that makes this trim. + # An earlier version used the kwarg API `coloring(...; decompression_eltype=R)` + # and relied on these assertions to recover the lost element type -- that does + # not work, because a typeassert narrows *downstream* of the call while the + # trim verifier rejects the *call itself*. The real fix lives in the + # `_color_*_impl` functions, which use the positional internal entry point. + # These assertions still earn their keep: they turn any future drift of the + # DESIGN.md section 3 table into a loud TypeError instead of a silent -1. + # NOTE: a green `test_libsmc.jl` does NOT imply a green build -- the Julia + # suite runs uncompiled, so it cannot see trim verifier errors. 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 +# +# Every one wraps its `_do_*` helper in try/catch, logs with @error and returns +# -1, exactly as LibKrylov.jl does. Return codes (DESIGN.md section 2): +# 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 +# =========================================================================== + +# --------------------------------------------------------------------------- +# smc_default_options — the defaults of DESIGN.md section 2. Always initialise +# an options struct with this before overriding individual fields. +# --------------------------------------------------------------------------- +@export_sig smc_default_options "SmcColoringOptions" + +Base.@ccallable function smc_default_options()::SmcColoringOptionsC + return SMC_DEFAULT_OPTIONS +end + +# --------------------------------------------------------------------------- +# smc_version — the SparseMatrixColorings.jl version of this library. +# --------------------------------------------------------------------------- +@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 and return an opaque handle. +# +# m, n : dimensions, both > 0 +# colptr : n+1 column pointers, in opts->index_base +# rowval : row indices of the nonzeros, in opts->index_base +# opts : options, or NULL for smc_default_options() +# result_out : receives the handle; release it with smc_result_free +# +# Only the structure is needed: the numerical 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 — color the pattern and 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 + +# --------------------------------------------------------------------------- +# smc_result_free — release a handle. Freeing 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 + +# --------------------------------------------------------------------------- +# smc_ncolors — total number of colors of the result. +# --------------------------------------------------------------------------- +@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 + +# --------------------------------------------------------------------------- +# smc_column_colors — color of every column; `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 + +# --------------------------------------------------------------------------- +# smc_row_colors — color of every row; `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 + +# --------------------------------------------------------------------------- +# smc_nnz — number of stored entries of the pattern this result was built from, +# which is 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 + +# --------------------------------------------------------------------------- +# smc_size — dimensions of the matrix this result was built from; `A_out` of +# smc_decompress must hold 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 + +# --------------------------------------------------------------------------- +# smc_compressed_size — dimensions of the compressed matrices. 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 the matrix into the dense buffers Br and Bc. +# +# nzval : the CSC values, in the same order as the rowval given to +# smc_coloring; double* or float* according to opts->dtype +# nzval_len : elements available in nzval; must be at least smc_nnz +# Br : row-compressed matrix, unused unless the partition is +# bidirectional (it may then be NULL with Br_len 0) +# Br_len : elements available in Br; must be at least Br_rows * Br_cols +# Bc : column-compressed matrix +# Bc_len : elements available in Bc; must be at least Bc_rows * Bc_cols +# +# Every length is an element count, not a byte count. Both buffers are +# column-major with the dimensions of smc_compressed_size, and are written in +# full (they need not be zeroed by the caller). 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) from the +# compressed form. Entries outside the sparsity pattern are set to zero. +# +# Br / Bc follow the rules of smc_compress; A_len is an element count and must +# be at least m * n, the dimensions reported by 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..ba427832 --- /dev/null +++ b/interfaces/src/c_enums.jl @@ -0,0 +1,62 @@ +# c_enums.jl — Julia mirror of the C types declared in include/smc.h. +# +# The enumerator *values* live in scripts/coloring_table.jl (the single source +# of truth shared with the header generator) and are already in scope here: +# +# SmcDataType SMC_FLOAT64 = 0, SMC_FLOAT32 = 1 +# SmcStructure SMC_NONSYMMETRIC = 0, SMC_SYMMETRIC = 1 +# SmcPartition SMC_COLUMN = 0, SMC_ROW = 1, SMC_BIDIRECTIONAL = 2 +# SmcDecompression SMC_DIRECT = 0, SMC_SUBSTITUTION = 1 +# SmcOrder SMC_NATURAL = 0 ... SMC_DYNAMIC_LARGEST_FIRST = 4 +# +# The GC roots for the opaque result handles are the typed stores of +# c_stores.jl. + +# --------------------------------------------------------------------------- +# SmcColoringOptionsC — Julia mirror of the SmcColoringOptions C struct. +# +# Eight `Cint` fields in exactly the order of DESIGN.md section 2 and of +# include/smc.h. All fields are 4 bytes, so the C and Julia layouts agree with +# no padding on every supported platform, and the struct is `isbits`: it can be +# `unsafe_load`ed straight from the caller's pointer and returned by value from +# `smc_default_options`. +# +# Changing the order of these fields is an ABI break. +# --------------------------------------------------------------------------- +struct SmcColoringOptionsC + structure :: Cint # SmcStructure — default SMC_NONSYMMETRIC + partition :: Cint # SmcPartition — default SMC_COLUMN + decompression :: Cint # SmcDecompression — default SMC_DIRECT + order :: Cint # SmcOrder — default SMC_NATURAL + 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 + +# The defaults documented in DESIGN.md section 2 and returned both by +# `smc_default_options` and 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 +) + +# Every field of an options struct is in range. Anything out of range is an +# invalid argument (-3), which is 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 for them. +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..7a9d181f --- /dev/null +++ b/interfaces/src/c_stores.jl @@ -0,0 +1,825 @@ +# c_stores.jl — typed handle stores and every operation that dispatches on a +# handle (queries, compression, decompression). +# +# `smc_coloring` builds a coloring result, roots it in one of the nine typed +# `Dict{Ptr{Cvoid},T}` stores of DESIGN.md section 3 and hands the caller an +# opaque handle. A parallel `Dict{Ptr{Cvoid},UInt8}` records the combo key of +# each handle, so a later call can recover the *concrete* type of the result it +# was given: `store_sym_col_subst_f32[handle]` has a statically known type, +# which is what `--trim=safe` requires. +# +# Why nine stores and not twelve: `decompression_eltype` does not appear in the +# Column / Row / StarSet result types, so those three are dtype-independent. +# +# The value types below were obtained by *running* Julia on a +# `SparseMatrixCSC{Float64,Int64}` input, not by reading the source; they match +# DESIGN.md section 3 verbatim. + +# --------------------------------------------------------------------------- +# Concrete 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 of 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 stored +# as a `SparsityPatternCSC` rather than a `SparseMatrixCSC`; its inner symmetric +# result is therefore 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} + +# --------------------------------------------------------------------------- +# The nine typed stores (DESIGN.md section 3) and the two side indices. +# +# Every 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}() + +# --------------------------------------------------------------------------- +# Handles +# +# DESIGN.md section 3 suggests `pointer_from_objref(result)`, but every +# `AbstractColoringResult` of SparseMatrixColorings is an *immutable* struct and +# `pointer_from_objref` refuses those ("cannot be used on immutable objects"). +# A monotone counter is used instead. It is strictly safer: an address is never +# recycled, so a stale handle can never be mistaken for a live one, which is +# exactly what makes use-after-free and double-free return -4 reliably. +# The handle is a token; it is never dereferenced. It starts at 1, so 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 + +# Root `res` in its typed store and publish the handle. `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 are served by nine stores. `@key_dispatch` expands to the +# if/elseif chain over the keys, so every branch indexes a store whose value +# type is statically known; `@store_dispatch` is the same chain but passes the +# store itself (used by `smc_result_free`). 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 is +# allowed to come in as NULL (there is nothing to point at), in which case an +# empty Julia matrix of the same type 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. +# +# Two independent reasons not to call `SparseMatrixColorings.compress` here: +# +# 1. Zero-copy. `compress` allocates a Julia `Matrix` that we would +# immediately copy into the caller's buffer and throw away. The loops +# below write straight into the C buffer instead. +# 2. It would not trim. `compress` builds its result with +# `stack(...) do g; dropdims(sum(A[:, g]; dims=2); dims=2); end`, and `sum` +# on a sparse matrix bottoms out in an unresolvable +# `Base.mapreduce_empty(::typeof(identity), ::Function, T)::Any`. +# +# Reason 1 alone would justify these loops, so no upstream change is needed. +# They compute exactly the same thing: 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 one is called from a branch where the result has a +# statically known concrete type, so the partition-based dispatch below is +# resolved at compile time and the -2 methods carry no run-time cost. +# +# A query that the partition cannot answer (row information of a column +# coloring, and vice versa) is -2, not -3: the argument is well formed, the +# combination just has no such 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) + +_typed_column_colors!(res::SmcResult{s,:column,d}, out::Ptr{Cint}, len::Cint) where {s,d} = + _copy_colors!(SparseMatrixColorings.column_colors(res), out, len) + +_typed_column_colors!( + res::SmcResult{s,:bidirectional,d}, out::Ptr{Cint}, len::Cint +) where {s,d} = _copy_colors!(SparseMatrixColorings.column_colors(res), out, len) + +_typed_ncolumn_groups(::SmcResult{s,:row,d}, ::Ptr{Cint}) where {s,d} = Cint(-2) + +_typed_ncolumn_groups(res::SmcResult{s,:column,d}, out::Ptr{Cint}) where {s,d} = + _store_int(out, length(SparseMatrixColorings.column_groups(res))) + +_typed_ncolumn_groups(res::SmcResult{s,:bidirectional,d}, out::Ptr{Cint}) where {s,d} = + _store_int(out, length(SparseMatrixColorings.column_groups(res))) + +_typed_column_group_size(::SmcResult{s,:row,d}, ::Cint, ::Ptr{Cint}) where {s,d} = Cint(-2) + +_typed_column_group_size( + res::SmcResult{s,:column,d}, group::Cint, out::Ptr{Cint} +) where {s,d} = _group_size(SparseMatrixColorings.column_groups(res), group, out) + +_typed_column_group_size( + res::SmcResult{s,:bidirectional,d}, group::Cint, out::Ptr{Cint} +) where {s,d} = _group_size(SparseMatrixColorings.column_groups(res), group, out) + +_typed_column_group!( + ::SmcResult{s,:row,d}, ::Cint, ::Ptr{Cint}, ::Cint, ::Cint +) where {s,d} = Cint(-2) + +_typed_column_group!( + res::SmcResult{s,:column,d}, group::Cint, out::Ptr{Cint}, len::Cint, base::Cint +) where {s,d} = _copy_group!(SparseMatrixColorings.column_groups(res), group, out, len, base) + +_typed_column_group!( + res::SmcResult{s,:bidirectional,d}, group::Cint, out::Ptr{Cint}, len::Cint, base::Cint +) where {s,d} = _copy_group!(SparseMatrixColorings.column_groups(res), group, out, len, base) + +## Row colors and groups — absent from a :column partition. + +_typed_row_colors!(::SmcResult{s,:column,d}, ::Ptr{Cint}, ::Cint) where {s,d} = Cint(-2) + +_typed_row_colors!(res::SmcResult{s,:row,d}, out::Ptr{Cint}, len::Cint) where {s,d} = + _copy_colors!(SparseMatrixColorings.row_colors(res), out, len) + +_typed_row_colors!( + res::SmcResult{s,:bidirectional,d}, out::Ptr{Cint}, len::Cint +) where {s,d} = _copy_colors!(SparseMatrixColorings.row_colors(res), out, len) + +_typed_nrow_groups(::SmcResult{s,:column,d}, ::Ptr{Cint}) where {s,d} = Cint(-2) + +_typed_nrow_groups(res::SmcResult{s,:row,d}, out::Ptr{Cint}) where {s,d} = + _store_int(out, length(SparseMatrixColorings.row_groups(res))) + +_typed_nrow_groups(res::SmcResult{s,:bidirectional,d}, out::Ptr{Cint}) where {s,d} = + _store_int(out, length(SparseMatrixColorings.row_groups(res))) + +_typed_row_group_size(::SmcResult{s,:column,d}, ::Cint, ::Ptr{Cint}) where {s,d} = Cint(-2) + +_typed_row_group_size(res::SmcResult{s,:row,d}, group::Cint, out::Ptr{Cint}) where {s,d} = + _group_size(SparseMatrixColorings.row_groups(res), group, out) + +_typed_row_group_size( + res::SmcResult{s,:bidirectional,d}, group::Cint, out::Ptr{Cint} +) where {s,d} = _group_size(SparseMatrixColorings.row_groups(res), group, out) + +_typed_row_group!( + ::SmcResult{s,:column,d}, ::Cint, ::Ptr{Cint}, ::Cint, ::Cint +) where {s,d} = Cint(-2) + +_typed_row_group!( + res::SmcResult{s,:row,d}, group::Cint, out::Ptr{Cint}, len::Cint, base::Cint +) where {s,d} = _copy_group!(SparseMatrixColorings.row_groups(res), group, out, len, base) + +_typed_row_group!( + res::SmcResult{s,:bidirectional,d}, group::Cint, out::Ptr{Cint}, len::Cint, base::Cint +) where {s,d} = _copy_group!(SparseMatrixColorings.row_groups(res), group, out, len, base) + +## Dimensions of the compressed matrices, as `(Br_rows, Br_cols, Bc_rows, Bc_cols)`. +## Only a bidirectional partition has a row-compressed matrix. + +_compressed_dims(res::SmcResult{s,:column,d}) where {s,d} = + (0, 0, size(res.A, 1), length(SparseMatrixColorings.column_groups(res))) + +_compressed_dims(res::SmcResult{s,:row,d}) where {s,d} = + (0, 0, length(SparseMatrixColorings.row_groups(res)), size(res.A, 2)) + +_compressed_dims(res::SmcResult{s,:bidirectional,d}) where {s,d} = ( + length(SparseMatrixColorings.row_groups(res)), + size(res.A, 2), + size(res.A, 1), + length(SparseMatrixColorings.column_groups(res)), +) + +## Partition predicate, used by the buffer checks below. It dispatches on the +## partition type parameter, so each caller 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. + +# Number of stored entries: exactly the length `nzval` must have in +# `smc_compress`. +_typed_nnz(res, out::Ptr{Cint}) = _store_int(out, SparseArrays.nnz(res.A)) + +# Dimensions of the colored matrix: `A_out` of `smc_decompress` holds m*n +# elements. +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`, and they are checked here, before a single element is read or +## written: the loops below and the `unsafe_wrap` of `_decompress_impl!` take +## the caller's word for the size of the buffer, so this is the only thing +## standing between a stale length and a heap overrun. +## +## The comparisons are made in `Csize_t`, which is unsigned: a length of 0 or of +## SIZE_MAX cannot wrap into a value that passes. Every required count comes +## from `_compressed_dims` or from `res.A`, so it is non-negative and its +## conversion to `Csize_t` is exact. + +# Br and Bc. 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) + # Unconditional and before anything else touches A_out: `_decompress_impl!` + # wraps an m-by-n `Matrix` over it, and that wrap believes whatever size it + # is given, so Julia's own bounds checks cannot help here. + 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..2c4357c3 --- /dev/null +++ b/interfaces/test/C/test_api.c @@ -0,0 +1,708 @@ +/* + * test_api.c - ABI and error-path tests for the libsmc C interface. + * + * Complements test_coloring.c (which checks that the colorings themselves are + * correct) by pinning down the parts of the contract a caller relies on but + * that a working coloring would not reveal: + * - the binary layout of SmcColoringOptions and the numeric value of every + * enumerator, so that a drift between smc.h and c_enums.jl is caught here + * rather than as silent memory corruption in user code + * - smc_default_options() and the NULL-options shortcut + * - the version macros + * - every documented return code: -2 for an unsupported combination, -3 for + * an invalid argument or a buffer that is too small, -4 for a handle that + * was already freed or never existed + * - the sizing queries smc_nnz and smc_size, which are the only way a caller + * holding nothing but a handle can size nzval and A_out + * - every buffer length of smc_compress and smc_decompress, one at a time, + * with a sentinel proving that a rejected call writes nothing at all + * - index_base 0 and 1 producing the same coloring + * - the Float32 compress/decompress path + * + * 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" + +/* ------------------------------------------------------------------------- + * Tiny test harness + * ------------------------------------------------------------------------- */ + +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] + +/* ------------------------------------------------------------------------- + * ABI: the layout of SmcColoringOptions is part of the contract. These are + * checked at compile time (so a mismatched header fails the build) and again + * at run time (so the message is readable). + * ------------------------------------------------------------------------- */ + +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); + +/* The Julia mirror in c_enums.jl is a struct of eight Cint fields in exactly + this order; anything else silently shifts every option. */ +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); + +/* ------------------------------------------------------------------------- + * Problem data + * + * A is the 4x6 pattern of the SparseMatrixColorings `compress` docstring: + * + * . . 4 6 . 9 + * 1 . . . 7 . + * . 2 . . 8 . + * . 3 5 . . . + * + * stored 0-based (colptr0/rowval0) and 1-based (colptr1/rowval1). + * ------------------------------------------------------------------------- */ + +#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; crossed with + the two dtypes these are the nine result stores of DESIGN.md section 3. */ +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; +} + +/* ========================================================================= + * Tests + * ========================================================================= */ + +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)"); + + /* The struct must be exactly eight consecutive ints with no padding: writing + through the struct and reading back as an int array must agree. */ + 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 (structure, partition, decompression) 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"); + + /* Bad enum values and index bases. */ + { + 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"); + } + } + + /* Short and NULL buffers on the queries. */ + 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"); + } + /* A column partition carries no row coloring. */ + { + 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"); + + /* An address that was never a handle behaves the same way. */ + 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"); +} + +/* ------------------------------------------------------------------------- + * The sizing queries. + * + * smc_nnz and smc_size close the gap that made the buffer-length promise of + * smc.h impossible to keep: without them a caller holding only a handle had no + * way of knowing how long nzval and A_out must be. Both are checked for every + * one of the nine result stores (six supported triples x two dtypes), on a + * NULL out pointer, and on a freed handle. + * ------------------------------------------------------------------------- */ + +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"); + + /* A NULL out pointer is an invalid argument, not a request to skip. */ + 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. + * + * smc.h promises that every buffer is followed by its length in elements and + * that the length is checked before a single element is read or written. Each + * length is understated on its own, with the buffer left at its full size, so + * a -3 can only come from the length check; the sentinel surviving is what + * 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; } + + /* Exactly the announced sizes are enough. */ + 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"); + + /* nzval_len, one element short. */ + 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"); + + /* Bc_len, one element short. */ + 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"); + + /* NULL buffers. */ + 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 length larger than needed 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'"); + + /* A_len, one element short. 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"); + + /* Bc_len is checked by smc_decompress too, and before A_out is touched. */ + 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"); + + /* Br_len alone, one element short. */ + 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"); + + /* Bc_len and nzval_len, unchanged from the column case but with Br present. */ + 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: NULL is -3, not "skip it". */ + 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 0 and 1 must describe the same matrix, hence the same coloring; + only the *group members* are shifted. */ +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); +} + +/* The Float32 path: same coloring, but compress/decompress work on float. */ +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"); + + /* The lengths count *elements* of the dtype, so they are the same numbers a + Float64 handle would use -- only the element size differs. */ + 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, rebuilt from the CSC data. */ + 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..2ac77f9c --- /dev/null +++ b/interfaces/test/C/test_coloring.c @@ -0,0 +1,807 @@ +/* + * test_coloring.c - correctness tests for the colorings produced by libsmc. + * + * Where test_api.c pins the ABI and the return codes, this file checks that + * the colorings themselves are usable, and it does so from first principles: + * nothing here compares against a hard-coded expected coloring, because a + * greedy coloring is allowed to change with the vertex order. Instead each + * coloring is verified against the property that makes it useful: + * + * - column partition: two columns of the same nonzero color never share a + * nonzero row, so the sum of a group can be split back into its columns + * - row partition: the same statement transposed + * - symmetric / direct: the coloring is proper and contains no bicolored + * path on four vertices (a star coloring) + * - symmetric / substitution: the coloring is proper and every two-colored + * subgraph is a forest (an acyclic coloring) + * - bidirectional / direct: every nonzero is recoverable, from its column + * group or from its row group + * - every combination: compress -> decompress reproduces the matrix, with the + * buffer lengths obtained from smc_nnz, smc_size and smc_compressed_size + * rather than recomputed, so the queries are checked against the pattern + * - every combination: understating any one buffer length by a single element + * is rejected with -3 and writes nothing + * + * All five orders and both postprocessing settings are exercised, in Float64 + * and Float32. + * + * 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" + +/* ------------------------------------------------------------------------- + * Tiny test harness + * ------------------------------------------------------------------------- */ + +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; + +/* ------------------------------------------------------------------------- + * Test matrices + * ------------------------------------------------------------------------- */ + +/* 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 graph minus a perfect + matching); a zero diagonal is what lets postprocessing hand out the neutral + color 0, which a full diagonal would forbid. */ +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 } +}; + +/* ------------------------------------------------------------------------- + * Helpers on the dense pattern + * ------------------------------------------------------------------------- */ + +/* 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 colored column_colors[j], or the + * only nonzero of column j among the rows colored row_colors[i]. 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: 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 - using the symmetry of A - from B[j][colors[i]] under the mirrored + * condition. + */ +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; +} + +/* ------------------------------------------------------------------------- + * Group consistency: 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; +} + +/* ------------------------------------------------------------------------- + * compress -> decompress round trip + * ------------------------------------------------------------------------- */ + +/* + * The three lengths smc_compress and smc_decompress need, read back from the + * API itself rather than from the Matrix struct: smc_nnz and smc_size are the + * only queries a caller holding nothing but a handle can use, so asking them + * here also checks that they agree with the pattern that was colored. + * Returns 0 if any query fails or disagrees. + */ +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; + } + + /* Sentinel fill: smc_compress and smc_decompress write the whole buffer. */ + 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; + + /* Br is NULL with a length of 0 for every non-bidirectional partition. */ + 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 are the same numbers as in the Float64 + round trip; only the element size differs. */ + 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. Run for each of the + * six supported partitions, which is what makes the Br checks reachable: Br + * only exists for SMC_BIDIRECTIONAL. 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. + * Returns 1 when every rejection behaved. + */ +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 is 0 for a non-bidirectional result and size(A,2) otherwise, so it + identifies the partition even when the row coloring is empty. br_len does + not: postprocessing can leave zero row groups, making 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; + + /* nzval_len and Bc_len (and Br_len when it exists), one short each. + Only when the buffer is non-empty: `len - 1` on a size_t 0 wraps to + SIZE_MAX, which is a valid (enormous) promise and is rightly accepted, so + the check would test the opposite of what it reads. This is not + hypothetical -- postprocessing can leave zero column groups, and then + bc_len really is 0. */ + 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; + } + + /* A_len and Bc_len (and Br_len), one short each, with the sentinel intact. */ + 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; + + /* The exact sizes still work after every rejection. */ + if (smc_decompress(result, Br, br_len, Bc, bc_len, out, a_len) != 0) ok = 0; + + free(Br); free(Bc); free(out); + return ok; +} + +/* ------------------------------------------------------------------------- + * One (matrix, options) case + * ------------------------------------------------------------------------- */ + +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"); + } + + /* ncolors is the total, which for a bidirectional partition counts both. */ + 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 are dtype-independent (they count elements), so one + pass on the Float64 buffers covers them for this partition. */ + CHECK(length_guards_ok(result, A), "every buffer length is checked, and short is -3"); + } + + CHECK(smc_result_free(result) == 0, "free"); +} + +/* ------------------------------------------------------------------------- + * smc_fast_coloring must agree with smc_coloring. + * ------------------------------------------------------------------------- */ + +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; a bidirectional partition fills both. */ + 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"); +} + +/* ------------------------------------------------------------------------- + * The whole matrix of supported combinations + * ------------------------------------------------------------------------- */ + +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 0 and 1 give the same coloring, for every partition. + * ------------------------------------------------------------------------- */ + +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"); + + /* Postprocessing only renames the surviving colors (injectively) and zeroes + the useless ones: 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..0a27f31f --- /dev/null +++ b/interfaces/test/Fortran/test_smc.f90 @@ -0,0 +1,1749 @@ +! 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: +! it exercises the same contract through the Fortran binding, so that a drift +! between smc.h and smc.f90 -- a missing bind(c) name, a wrong argument kind, a +! value/reference mismatch -- is caught here rather than as silent memory +! corruption in user code. +! +! What is covered: +! - smc_version and the field defaults of smc_default_options +! - all six supported (structure, partition, decompression) combinations, +! crossed with the five orders, postprocessing on and off, and both dtypes +! (SMC_FLOAT64 / SMC_FLOAT32) +! - smc_ncolors, smc_column_colors, smc_row_colors and the group queries, +! with index_base 0 and 1 agreeing (same coloring, members shifted by one) +! - smc_nnz / smc_size / smc_compressed_size, then a compress -> decompress +! round trip whose buffer lengths come *from those queries*, never from a +! hard-coded constant, verified against the original nonzeros +! - the documented return codes: -2 for an unsupported combination, -3 for an +! invalid argument or a buffer that is too short, -4 for a freed handle +! - structural validity checked from first principles: two columns carrying +! the same nonzero color never share a nonzero row, and every nonzero is +! recoverable from its group. Nothing is compared against a hard-coded +! expected coloring, because a greedy coloring may legitimately change with +! the vertex order. +! +! Four Fortran-specific pitfalls this file is careful about: +! 1. every object whose address is taken with c_loc carries the target +! attribute -- without it the address is not even guaranteed to exist; +! 2. a buffer length may legitimately be zero (postprocessing can leave zero +! column groups), so no "one element short" test is run without first +! checking that the length is positive: integer(c_size_t) is signed in +! Fortran and 0 - 1 arrives on the C side as SIZE_MAX, an enormous and +! perfectly valid promise, which would assert the opposite of the intent; +! 3. a result is bidirectional when Br_cols > 0, never when Br_len > 0: +! Br_cols is 0 for the other partitions and size(A,2) here, while Br_len +! can be 0 for a bidirectional result whose row coloring is empty; +! 4. trim() is never applied to an element of a character array, nor to a +! character component of an array element: the value is copied into a +! scalar first and trimmed with an explicit substring, X(1:len_trim(X)). +! The array-element form is what killed this suite on Windows while every +! other platform passed, and Krylov.jl hit the same thing -- which is why +! its Fortran sources contain no trim() at all. +! +! 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' ! <- after implicit none; interfaces, enumerators, + ! and type(SmcColoringOptions) + + ! ------------------------------------------------------------------------- + ! Test harness state and problem data. Everything declared here is 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 and + ! the useful part is m / n / nnz, so that a single fixed-size type can hold + ! 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; crossed with the two dtypes these are the nine + ! result stores of DESIGN.md section 3. Fortran is column-major, so column c + ! is one (structure, partition, decompression). + 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 + + ! ------------------------------------------------------------------------- + ! Main + ! ------------------------------------------------------------------------- + + 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 + + ! ========================================================================= + ! Tiny test harness + ! ========================================================================= + + subroutine check(cond, msg) + logical, intent(in) :: cond + character(len=*), intent(in) :: msg + ! 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, so the section + ! headers alone only narrow the failure to a whole subroutine; with this on, + ! the last line printed is the last check that completed. Used to localize + ! a Windows-only failure that cannot be reproduced on Linux or macOS. + 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 + + ! ========================================================================= + ! Helpers on the dense pattern + ! ========================================================================= + + ! 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: + ! that is exactly what lets the sum of a group be split back into columns. + 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. use_rows / use_cols select + ! the colorings the partition actually produces. + 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 of directly_recoverable: with a single 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 - using the symmetry of A - from 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 + + ! ========================================================================= + ! Small wrappers around the API + ! ========================================================================= + + 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 + + ! ========================================================================= + ! Group consistency: 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 + + ! ========================================================================= + ! Buffer lengths, read back from the API itself + ! + ! smc_nnz and smc_size are the only queries a caller holding nothing but a + ! handle can use, so asking them here also checks that they agree with the + ! pattern that was colored. 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 + + ! ========================================================================= + ! compress -> decompress round trips + ! ========================================================================= + + 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) + + ! The lengths count *elements* of the dtype, so they are the same numbers a + ! Float64 handle would use; only the element size differs. + 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 element was written. A length is only understated when it is positive: + ! integer(c_size_t) is signed in Fortran, so 0 - 1 arrives on the C side as + ! SIZE_MAX -- a valid, enormous promise that is rightly accepted, which would + ! make the assertion read the opposite of its intent. This is not + ! hypothetical: postprocessing can leave zero column groups, and then bc_len + ! really is 0. + ! ========================================================================= + + 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. + + ! Restore a usable compressed form after all those rejections. + 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. + + ! Nothing was written by any of the rejected calls. + 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 + + ! ========================================================================= + ! One (matrix, options) case + ! ========================================================================= + + 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 + + ! ncolors is the total, which for a bidirectional partition counts both. + 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 they are dtype-independent: one + ! pass on the Float64 buffers covers them for this partition. + 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 + + ! ========================================================================= + ! smc_fast_coloring must agree with smc_coloring + ! ========================================================================= + + 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; a bidirectional partition fills both. + 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 + + ! ========================================================================= + ! The whole matrix of supported combinations + ! ========================================================================= + + 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)") + + ! The members, on the other hand, are indices and must be shifted by one. + 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") + + ! Postprocessing only renames the surviving colors injectively and zeroes + ! the useless ones: 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 + + ! ========================================================================= + ! Version and options + ! ========================================================================= + + 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 happens to be 0 (SMC_NONSYMMETRIC, SMC_COLUMN, SMC_DIRECT, + ! SMC_NATURAL, SMC_FLOAT64 and the three flags are all zero), so checking + ! the fields against their expected values cannot tell a working + ! smc_default_options from one that writes nothing at all: both leave a + ! zeroed struct. smc_default_options is the one entry point returning a + ! derived type BY VALUE, i.e. the one place where the struct-return ABI is + ! exercised, so that blind spot is worth closing. Poison the struct first + ! and require the call to overwrite it. + 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") + + ! Out-of-range enum values and index bases. + 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 + + ! Short and c_null_ptr buffers on the queries. + 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 the note on length_guards. + 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") + + ! A column partition carries no row coloring. + 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") + + ! A real address that was never a handle behaves the same way. + 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") + + ! c_null_ptr is rejected, not a crash. + 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 + + ! ========================================================================= + ! The sizing queries, for every one of the nine result stores + ! ========================================================================= + + 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") + + ! A c_null_ptr out pointer is an invalid argument, not a request to skip. + 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..32cdfe06 --- /dev/null +++ b/interfaces/test/test_libsmc.jl @@ -0,0 +1,1314 @@ +# test_libsmc.jl — validates the C interface logic by loading LibSMC.jl as a +# regular Julia module and calling its @ccallable functions directly. +# +# This avoids loading the juliac-compiled libsmc.so from within a Julia process +# (which would trigger a second Julia runtime via ijl_adopt_thread and crash +# immediately). The compiled libsmc.so is validated separately by the C tests +# (interfaces/test/C/test_api.c, interfaces/test/C/test_coloring.c) which load +# it from a native C process with no prior Julia runtime. +# +# Usage (from the SparseMatrixColorings.jl root): +# julia --startup-file=no --project=. interfaces/test/test_libsmc.jl +# +# The final `@testset` throws when anything fails, so the process exits with a +# nonzero status: this file is directly usable as a CI step. + +using Test +using SparseArrays +using SparseMatrixColorings + +# ============================================================================ +# Load LibSMC as a plain Julia module (no dlopen, no compiled library) +# ============================================================================ + +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()) + +# The six supported (structure, partition, decompression) triples; crossed with +# the two dtypes this is the 9-entry store table of DESIGN.md §3 (the first +# three triples are dtype-independent). +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 with concrete argument +# types. Rather than hard-coding whether an argument was declared `Ptr{Cvoid}` +# or `Ptr{Cint}`, we read the (unique) method signature and convert each +# argument accordingly. Everything is wrapped in `GC.@preserve` so the Julia +# objects backing the raw pointers stay rooted for the duration of the call. +# ============================================================================ + +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 + +# The options struct lives in c_enums.jl; recover its 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, defaults from DESIGN.md §2. +""" +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. +options_struct(o) = SmcOptions(o.structure, o.partition, o.decompression, o.order, + o.postprocessing, o.symmetric_pattern, + o.index_base, o.dtype) + +# ============================================================================ +# Thin wrappers mirroring the C prototypes of DESIGN.md §2 +# ============================================================================ + +"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 + +# Always allocate at least one element, so that a deliberately short `len` is +# tested against a valid non-NULL buffer rather than an empty array. +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: DESIGN.md §2 states that compress and +# decompress write the *whole* dense output, so no sentinel may survive a +# successful call -- and, symmetrically, *every* sentinel must survive a call +# rejected for a short buffer, which is what proves the length is checked +# before a single element is touched. +const SENTINEL = -987.0 + +""" + c_compress(handle, nzval, dims; kwargs...) + +Call `smc_compress` with buffers of exactly the size `smc_compressed_size` +announced. Each of `nzval_len`, `Br_len` and `Bc_len` defaults to the true +length of its buffer and can be overridden on its own; the buffer itself keeps +its full size, so a short length is a *lie about a valid buffer* — precisely the +case the length checks exist for. `*_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 + # A zero-sized compressed matrix has nothing to point at: 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`, +and `A_len` (like `Br_len` and `Bc_len`) can be understated independently. +""" +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. +This is the defining property of a valid column coloring: it is what makes the +sum of the columns of a group recoverable entry by entry. +""" +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 + +check_row_disjointness(S::SparseMatrixCSC, colors::Vector{Int}) = + check_column_disjointness(SparseMatrixCSC(transpose(S)), colors) + +"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) + +Every path on four vertices `i - j - k - l` uses at least three colors, i.e. +there is no bicolored `P4`. This is the structural requirement for *direct* +decompression of a symmetric matrix, and it is checked here from the pattern +alone, independently of what SparseMatrixColorings believes. +""" +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) + +The first-principles statement of what a *direct* coloring must guarantee: +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]` (when no other row of that color has a +nonzero in column `j`). Pass `row_colors = nothing` for a column partition and +`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`, the entry `A[i, j]` can be read from `B[i, colors[j]]` +when column `j` is the only one of its color meeting row `i`, or — using the +symmetry of `A` — from `B[j, colors[i]]` under the mirrored condition. +""" +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 must be exactly the fibers of the color vector: group `g` lists the +indices of color `g`, in the caller's index base, and their union is the set of +non-neutral indices. +""" +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*: postprocessing can then assign the +# neutral color 0 to some vertices, which a full diagonal would forbid. +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 +]) + +matrices_for(structure) = + structure == SMC_SYMMETRIC ? (A_SYM, A_SYM_ZERO_DIAG) : (A_NONSYM, A_NONSYM2) + +# ============================================================================ +# 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) + +Compression as defined in the manual: the compressed matrix is the sum of the +columns (resp. rows) of each group. The groups are the ones the C API itself +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 (sum of the columns / rows of a + # group), where the groups are the ones the API itself reports. + 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 +# +# smc.h promises that every buffer crossing the interface carries its length, +# that the length is checked before a single element is read or written, and +# that every sizing question has a query. These tests are what make that claim +# true rather than aspirational: `smc_nnz` and `smc_size` are the only way a +# caller holding nothing but a handle can size `nzval` and `A_out`, and the +# sentinel checks below prove the rejection happens *before* the write. +# ============================================================================ + +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 is allocated at its full size and pre-filled; only the + # announced length shrinks. A surviving sentinel is the proof that 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 is simply a very generous + # promise; it must be accepted, 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) + + # smc.h: a buffer may be NULL exactly when the partition produces no coloring + # for that dimension; SMC_BIDIRECTIONAL fills both, so neither may be NULL. + 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 +# +# DESIGN.md §3 splits the results over nine typed stores, keyed by +# structure*16 + partition*4 + decompression*2 + dtype. Keeping one handle of +# every kind alive at the same time checks that the stores really are +# independent and that the key correctly routes each query back to its 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) + + # Each handle still answers for its own result while all the others are alive. + 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 + + # Bad enum values and index bases. + 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 + + # compress / decompress with NULL buffers. Lengths are element counts of + # the dtype, and follow their buffer immediately. + _, 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 each of its +# rejections is reachable only through a malformed CSC pattern -- which no +# other test builds, so all four branches would otherwise be dead code. They +# matter: `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, so `rowval` is never read and a short one is safe here. + 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, so a colptr[n] + # claiming more is garbage. It is rejected *before* `rowval` is read, which + # is what a two-element `rowval` proves here: without the bound this call + # would walk 10 entries off the end of a length-2 array. + check_rejected(2, 2, Cint[0, 0, 10], Cint[0, 0], base0) + check_rejected(2, 2, Cint[1, 1, 11], Cint[1, 1], base1) +end + +# ============================================================================ +# Run everything +# ============================================================================ + +@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. If the two drift, the + # header misdeclares the ABI and a C caller reads arguments out of whatever + # happens to be in the argument registers. Nothing else in the pipeline sees + # it: the tests below build their calls by reflecting on the Julia methods, so + # they are blind to the declared signature by construction. + @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 + # `$name` argument `$argname` declared as `$ctype` + @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/src/interface.jl b/src/interface.jl index 0d183c9c..ab08aa8b 100644 --- a/src/interface.jl +++ b/src/interface.jl @@ -186,7 +186,17 @@ julia> collect.(column_groups(result)) - [`compress`](@ref) - [`decompress`](@ref) """ -function coloring( +# `@constprop :aggressive` is not a micro-optimization. +# +# Julia widens `Type{R}` to `DataType` when it builds the keyword-argument tuple, +# so without it inference loses `R` and this returns a `TreeSetColoringResult` +# (or `BicoloringResult`) whose last type parameter is missing -- even when the +# caller passes a literal `decompression_eltype=Float32`. The value returned at +# run time is still correct, so nothing observable breaks in normal use, but the +# call becomes unresolvable for static compilation: `juliac --trim=safe` rejects +# it with an "unresolved call" verifier error. +# It also matters to anyone storing results in a concretely typed container. +Base.@constprop :aggressive function coloring( A::AbstractMatrix, problem::ColoringProblem, algo::GreedyColoringAlgorithm; diff --git a/test/runtests.jl b/test/runtests.jl index ec679d4e..9801000d 100644 --- a/test/runtests.jl +++ b/test/runtests.jl @@ -88,6 +88,9 @@ include("utils.jl") include("type_stability.jl") end end + @testset "Static compilation" begin + include("static_compilation.jl") + end @testset "Allocations" begin include("allocations.jl") end diff --git a/test/static_compilation.jl b/test/static_compilation.jl new file mode 100644 index 00000000..649a930d --- /dev/null +++ b/test/static_compilation.jl @@ -0,0 +1,47 @@ +# 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. + +using SparseArrays +using SparseMatrixColorings +using Test + +function _colored_result_type(problem, algo, ::Type{R}) where {R} + return only( + Base.return_types( + (A, p, a, sp) -> coloring(A, p, a; decompression_eltype=R, symmetric_pattern=sp), + (SparseMatrixCSC{Float64,Int}, typeof(problem), typeof(algo), Bool), + ), + ) +end + +const STATIC_COMBOS = [ + (ColoringProblem{:nonsymmetric,:column}(), GreedyColoringAlgorithm{:direct}()), + (ColoringProblem{:nonsymmetric,:row}(), GreedyColoringAlgorithm{:direct}()), + (ColoringProblem{:symmetric,:column}(), GreedyColoringAlgorithm{:direct}()), + # The three below carry `decompression_eltype` in their result type, so they + # are the ones that actually break without the annotation. + (ColoringProblem{:symmetric,:column}(), GreedyColoringAlgorithm{:substitution}()), + (ColoringProblem{:nonsymmetric,:bidirectional}(), GreedyColoringAlgorithm{:direct}()), + (ColoringProblem{:nonsymmetric,:bidirectional}(), GreedyColoringAlgorithm{:substitution}()), +] + +@testset "coloring infers a concrete result type" begin + @testset "$(typeof(problem)) / $(typeof(algo)) / $R" for (problem, algo) in + STATIC_COMBOS, + R in (Float32, Float64) + + RT = _colored_result_type(problem, algo, R) + concrete = isconcretetype(RT) + concrete || @error """ + `coloring` no longer infers a concrete result type. + + This breaks static compilation: `juliac --trim=safe` will reject the + call with an "unresolved call" verifier error, and the C and Fortran + interfaces will stop building. + """ problem = typeof(problem) algorithm = typeof(algo) decompression_eltype = R inferred = RT + @test concrete + end +end