;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Fis Trivial ;;; Copyright © 2018, 2020 Tobias Geerinckx-Rice ;;; Copyright © 2023 Andy Tai ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or (at ;;; your option) any later version. ;;; ;;; GNU Guix is distributed in the hope that it will be useful, but ;;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see . (define-module (gnu packages opencl) #:use-module (guix build-system gnu) #:use-module (guix build-system cmake) #:use-module (guix build-system python) #:use-module (guix download) #:use-module (guix utils) #:use-module (guix git-download) #:use-module ((guix licenses) #:prefix license:) #:use-module (guix packages) #:use-module (gnu packages) #:use-module (gnu packages autotools) #:use-module (gnu packages gl) #:use-module (gnu packages gnupg) #:use-module (gnu packages compression) #:use-module (gnu packages libedit) #:use-module (gnu packages llvm) #:use-module (gnu packages mpi) #:use-module (gnu packages ncurses) #:use-module (gnu packages pkg-config) #:use-module (gnu packages python) #:use-module (gnu packages python-xyz) #:use-module (gnu packages ruby) #:use-module (gnu packages video) #:use-module (gnu packages xdisorg) #:use-module (gnu packages xorg)) ;; This file adds OpenCL implementation related packages. Due to the fact that ;; OpenCL devices like GPU are not availabl
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2015 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2015, 2016, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2024 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu packages netpbm)
  #:use-module (gnu packages)
  #:use-module (gnu packages compression)
  #:use-module (gnu packages flex)
  #:use-module (gnu packages ghostscript)
  #:use-module (gnu packages image)
  #:use-module (gnu packages perl)
  #:use-module (gnu packages pkg-config)
  #:use-module (gnu packages python)
  #:use-module (gnu packages xml)
  #:use-module (gnu packages xorg)
  #:use-module (guix build-system gnu)
  #:use-module ((guix licenses) #:select (gpl2))
  #:use-module (guix packages)
  #:use-module (guix svn-download)
  #:use-module (guix utils))

(define-public netpbm
  (package
   (name "netpbm")
   (version "10.78.3")
   (source (origin
            (method svn-fetch)
            ;; At the time of first packaging, the "super-stable" and
            ;; "stable" versions did not compile with newer libpng;
            ;; we needed the "advanced" version.
            ;; The currently highest stable version is 10.47.53,
            ;; the currently highest advanced version is 10.69.4,
            ;; svn release 2397.
            ;; To determine the correct release: "svn log version.mk".
            (uri (svn-reference
                   (url "http://svn.code.sf.net/p/netpbm/code/advanced")
                   (revision 2965)))
            (sha256
              (base32
               "1k7as9qi1942wyjxpvbf02wg0h4braw44m3m3vvi8sm9y5z1m967"))
            (patches (search-patches "netpbm-CVE-2017-2586.patch"
                                     "netpbm-CVE-2017-2587.patch"))
            (file-name (string-append name "-" version "-checkout"))
            (modules '((guix build utils)))
            (snippet
             '(begin
                ;; Remove non-FSDG-compliant code.

                (define-syntax drop
                  (syntax-rules (in)
                    ;; Remove PROGRAM from DIRECTORY/Makefile, and remove
                    ;; DIRECTORY/PROGRAM and DIRECTORY/PROGRAM.c.
                    ((_ program ... in directory)
                     (begin
                       (substitute* (string-append directory "/Makefile")
                         ((program) "") ...)

                       (let* ((subdir (string-append directory "/" program))
                              (dot-c  (string-append subdir ".c")))
                         (when (file-exists? subdir)
                           (delete-file-recursively subdir))
                         (when (file-exists? dot-c)
                           (delete-file dot-c)))

                       ...))))

                ;; Drop advertisement for non-free program.
                (drop "hpcdtoppm" in "converter/ppm")

                ;; Drop programs without a license, see
                ;; <http://packages.debian.org/changelogs/pool/main/n/netpbm-free/netpbm-free_10.0-12.2/libnetpbm10.copyright>.
                (drop "pbmto4425" "pbmtoln03" "pbmtolps" "pbmtopk" "pktopbm"
                      in "converter/pbm")
                (drop "spottopgm" in "converter/pgm")
                (drop "ppmtopjxl" in "converter/ppm")

                ;; Remove timestamps from the generated code.
                (substitute* "buildtools/makepointerman"
                  (("gmctime[(][)]")
                   "\"Thu Jan 1 00:00:00 1970\""))
                (substitute* "buildtools/stamp-date"
                  (("^DATE=.*")
                   "DATE=\"Thu Jan 01 00:00:00+0000 1970\"\n")
                  (("^USER=.*")
                   "USER=Guix\n"))
                #t))))

   (build-system gnu-build-system)
   (inputs `(("ghostscript" ,ghostscript)
             ("libjpeg" ,libjpeg-turbo)
             ("libpng" ,libpng)
             ("libtiff" ,libtiff)
             ("libxml2" ,libxml2)
             ("xorg-rgb" ,xorg-rgb)
             ("zlib" ,zlib)))
   (native-inputs
     `(("flex" ,flex)
       ("perl" ,perl)
       ("pkg-config" ,pkg-config)
       ("python" ,python-wrapper)))
   (arguments
    `(#:modules ((guix build gnu-build-system)
                 (guix build utils)
                 (ice-9 match))
      #:phases
      (modify-phases %standard-phases
       (replace 'configure
         (lambda* (#:key inputs outputs #:allow-other-keys)
           (copy-file "config.mk.in" "config.mk")
           (chmod "config.mk" #o664)
           (let ((f (open-file "config.mk" "a")))
             (display "CC=gcc\n" f)
             (display "CFLAGS_SHLIB += -fPIC\n" f)
             (display "TIFFLIB = libtiff.so\n" f)
             (display "JPEGLIB = libjpeg.so\n" f)
             (display "ZLIB = libz.so\n" f)
             (display (string-append "LDFLAGS += -Wl,-rpath=" %output "/lib") f)
             (close-port f))

           (let ((rgb (search-input-file inputs "/share/X11/rgb.txt")))
             (substitute* "config.mk"
               (("/usr/share/netpbm/rgb.txt") rgb))

             ;; Our Ghostscript no longer provides the 'gs' command, only
             ;; 'gsc', so look for that instead.
             (substitute* "converter/other/pstopnm.c"
               (("\"%s/gs\"")
                "\"%s/gsc\"")
               (("/usr/bin/gs")
                (search-input-file inputs "/bin/gsc"))))))
       (add-before 'check 'setup-check
         (lambda _
           ;; install temporarily into /tmp/netpbm
           (invoke "make" "package")
           ;; remove test requiring X
           (substitute* "test/all-in-place.test" (("pamx") ""))
           ;; do not worry about non-existing file
           (substitute* "test/all-in-place.test" (("^rm ") "rm -f "))
           ;; remove four tests that fail for unknown reasons
           (substitute* "test/Test-Order"
             (("all-in-place.test") "")
             (("pnmpsnr.test") "")
             (("pnmremap1.test") "")
             (("gif-roundtrip.test") "")

             ;; These two tests fail on powerpc-linux.
             ,@(if (target-ppc32?)
                   `((("pbmtog3\\.test") "")
                     (("g3-roundtrip\\.test") ""))
                   '())

             ;; These two tests started failing in netpbm-10.78.3.
             (("jpeg-roundtrip.test") "")
             (("pbmtext.test") "")

             ;; Skip tests that use nonfree programs that we don't build.
             (("ps-alt-roundtrip.test") "" )
             (("pbm-misc-converters.test") ""))
           #t))
       (replace 'install
         (lambda* (#:key outputs make-flags #:allow-other-keys)
           (let ((out (assoc-ref outputs "out")))
             (apply invoke "make" "package"
                    (string-append "pkgdir=" out) make-flags)
             ;; Remove superfluous files.
             (with-directory-excursion out
               (for-each delete-file-recursively
                         '("config_template" "pkginfo" "README" "VERSION"
                           "link/" "misc/"))
               ;; Install the required ‘libnetpbm.so’ link.
               ;; See <https://issues.guix.gnu.org/issue/40376>.
               (with-directory-excursion "lib"
                 (symlink
                  (match (find-files "." "^libnetpbm\\.so\\.[^.]*\\.[^.]*$")
                         ((head _ ...) head))
                  "libnetpbm.so"))
               #t)))))))
   (synopsis "Toolkit for manipulation of images")
   (description
    "Netpbm is a toolkit for the manipulation of graphic images, including
the conversion of images between a variety of different formats.
There are over 300 separate tools in the package including converters for
about 100 graphics formats.")
   (license gpl2)
   (home-page "https://netpbm.sourceforge.net/")))
(commit (string-append "v" version)))) (sha256 (base32 "1pw4q0hi5ynx34fvzryravz3jbh89f9cg60fkjj77sxh9xw8phdd")) (file-name (git-file-name name version)) (modules '((guix build utils))) (snippet '(begin ;; "kernel/test_printf_vectors" and ;; "kernel/test_printf_vectors_ulongn" ;; fail on aarch5 and likely other platforms ;; as commented in CMakeLists.txt ;; thus disable the block in CMakeList.txt adding ;; these two tests (substitute* "tests/kernel/CMakeLists.txt" (("NOT ENABLE_POCL_FLOAT_CONVERSION") "false")))))) (build-system cmake-build-system) (native-inputs (list libltdl pkg-config python-3)) (inputs (list clang-15 llvm-15 `(,hwloc-2 "lib") opencl-icd-loader)) (arguments `(#:configure-flags (let* ((libdir (string-append (assoc-ref %outputs "out") "/lib"))) (list "-DENABLE_ICD=ON" "-DENABLE_TESTSUITES=ON" ;; We are not developers, don't run conformance suite. "-DENABLE_CONFORMANCE=OFF" (string-append "-DEXTRA_HOST_LD_FLAGS=-L" (assoc-ref %build-inputs "libc") "/lib") ;; We need both libdir and libdir/pocl in RUNPATH. (string-append "-DCMAKE_INSTALL_RPATH=" libdir ";" libdir "/pocl"))) #:phases (modify-phases %standard-phases (add-before 'check 'set-HOME (lambda _ (setenv "HOME" "/tmp") ;; Since 2.9.0, hwloc fails when /sys is missing, so provide a ;; fake topology. (setenv "HWLOC_SYNTHETIC" "4")))))) (home-page "http://portablecl.org/") (synopsis "Portable Computing Language (pocl), an OpenCL implementation") (description "Pocl is a portable implementation of the OpenCL standard (1.2 with some 2.0 features supported). This project seeks to improve performance portability of OpenCL programs with the kernel compiler and the task run-time, reducing the need for target-dependent manual optimizations. pocl uses Clang as an OpenCL C frontend and LLVM for kernel compiler implementation, and as a portability layer. Thus, if your desired target has an LLVM backend, it should be able to get OpenCL support easily by using pocl.") (license license:expat))) (define-public python-pytools (package (name "python-pytools") (version "2021.2.7") (source (origin (method url-fetch) (uri (pypi-uri "pytools" version)) (sha256 (base32 "1yyr4k6sqx859gjhc02633l2vxwdnj6m2f5blmf7dgq0gzzgcf05")))) (build-system python-build-system) (arguments `(#:tests? #f)) ; Tests depend on packages not present in Guix. (propagated-inputs (list python-appdirs python-numpy)) (home-page "https://pypi.org/project/pytools/") (synopsis "Assorted tools for Python") (description "Pytools is a bag of things that are ``missing'' from the Python standard library: @itemize @item small helper functions such as @code{len_iterable}, @code{argmin}, tuple generation, permutation generation, ASCII table pretty printing, GvR's @code{monkeypatch_xxx} hack, the elusive @code{flatten}, and much more. @item Michele Simionato's decorator module @item A time-series logging module, @code{pytools.log}. @item Batch job submission, @code{pytools.batchjob}. @item A lexer, @code{pytools.lex}. @end itemize\n") (license license:expat))) (define-public python-pyopencl (package (name "python-pyopencl") (version "2021.2.6") (source (origin (method git-fetch) (uri (git-reference (url "https://github.com/inducer/pyopencl.git") (commit (string-append "v" version)) (recursive? #t))) (file-name (git-file-name name version)) (sha256 (base32 "1s2cls7avxvf753zzpx422ikslaxdnm8rz58zg7mal15yak0wv2x")))) (build-system python-build-system) (arguments `(#:tests? #f)) ; Tests cannot find pygpu_language_opencl.cpp (inputs (list opencl-headers pybind11 opencl-icd-loader)) ;libOpenCL (propagated-inputs (list python-appdirs python-numpy python-pytools python-mako)) (home-page "https://mathema.tician.de/software/pyopencl") (synopsis "Python wrapper for OpenCL") (description "PyOpenCL lets you access parallel computing devices such as GPUs from Python @i{via} OpenCL.") (license license:expat)))