|
| 1 | +;;; GNU Guix development package. |
| 2 | +;;; |
| 3 | +;;; To build and install, close this repository, and from the project root run |
| 4 | +;;; the following: |
| 5 | +;;; |
| 6 | +;;; guix package --install-from-file=jbuild.scm |
| 7 | +;;; |
| 8 | +;;; To bootstrap a development environment container, the following command is |
| 9 | +;;; helpful: |
| 10 | +;;; |
| 11 | +;;; guix shell --container --development --file=jbuild.scm |
| 12 | +;;; |
| 13 | + |
| 14 | +(define-module (jsoftware) |
| 15 | + #:use-module ((ice-9 popen) #:select (open-pipe* |
| 16 | + close-pipe)) |
| 17 | + #:use-module ((ice-9 rdelim) #:select (read-line)) |
| 18 | + #:use-module ((ice-9 match) #:select (match match-lambda)) |
| 19 | + #:use-module ((srfi srfi-1) #:select (any every)) |
| 20 | + #:use-module ((srfi srfi-26) #:select (cut)) |
| 21 | + #:use-module ((guix gexp) #:select (gexp |
| 22 | + local-file |
| 23 | + program-file)) |
| 24 | + #:use-module ((guix records) #:select (define-record-type*)) |
| 25 | + #:use-module ((guix licenses) #:prefix license: #:select (gpl3+)) |
| 26 | + #:use-module ((guix utils) #:select (target-arm? target-64bit?)) |
| 27 | + #:use-module ((guix build-system gnu) #:select (gnu-build-system |
| 28 | + %gnu-build-system-modules)) |
| 29 | + #:use-module ((guix build-system trivial) #:select (trivial-build-system)) |
| 30 | + #:use-module ((guix build utils) #:select (substitute* with-directory-excursion)) |
| 31 | + #:use-module ((guix packages) #:select (base32 |
| 32 | + origin |
| 33 | + package |
| 34 | + package/inherit |
| 35 | + package-properties |
| 36 | + package-version)) |
| 37 | + #:use-module ((gnu packages) #:select (search-patches)) |
| 38 | + #:use-module ((gnu packages libedit) #:select (libedit)) |
| 39 | + #:use-module ((gnu packages llvm) #:select (clang-toolchain |
| 40 | + libomp)) |
| 41 | + #:use-module ((gnu packages maths) #:select (sleef))) |
| 42 | + |
| 43 | + |
| 44 | +(define %source-dir (dirname (current-filename))) |
| 45 | + |
| 46 | +(define (git-version) |
| 47 | + "Return a version string suitable for development builds." |
| 48 | + (let* ((pipe (with-directory-excursion %source-dir |
| 49 | + (open-pipe* OPEN_READ "git" "describe" "--always" "--tags"))) |
| 50 | + (version (read-line pipe))) |
| 51 | + (close-pipe pipe) |
| 52 | + version)) |
| 53 | + |
| 54 | +(define (git-user) |
| 55 | + "Return a user info string scraped from Git." |
| 56 | + (let* ((name-pipe (with-directory-excursion %source-dir |
| 57 | + (open-pipe* OPEN_READ "git" "config" "user.name"))) |
| 58 | + (email-pipe (with-directory-excursion %source-dir |
| 59 | + (open-pipe* OPEN_READ "git" "config" "user.email"))) |
| 60 | + (name (read-line name-pipe)) |
| 61 | + (email (read-line email-pipe)) |
| 62 | + (status (every identity (map close-pipe `(,name-pipe ,email-pipe))))) |
| 63 | + (format #f "~a <~a>" name email))) |
| 64 | + |
| 65 | +;; Predicate intended for SELECT? argument of local-file procedure. Returns |
| 66 | +;; true if and only if file is tracked by git. |
| 67 | +(define git-file? |
| 68 | + (let* ((pipe (with-directory-excursion %source-dir |
| 69 | + (open-pipe* OPEN_READ "git" "ls-files"))) |
| 70 | + (files (let loop ((lines '())) |
| 71 | + (match (read-line pipe) |
| 72 | + ((? eof-object?) (reverse lines)) |
| 73 | + (line (loop (cons line lines)))))) |
| 74 | + (status (close-pipe pipe))) |
| 75 | + (lambda (file stat) |
| 76 | + (match (stat:type stat) |
| 77 | + ('directory #t) |
| 78 | + ((or 'regular 'symlink) (any (cut string-suffix? <> file) files)) |
| 79 | + (_ #f))))) |
| 80 | + |
| 81 | + |
| 82 | +(define (ijconsole) |
| 83 | + "Generate a G-exp script that detects AVX/AVX2 support at runtime and |
| 84 | + executes jconsole with the appropriate libj.so and profile.ijs." |
| 85 | + (program-file "ijconsole" |
| 86 | + #~(begin |
| 87 | + (use-modules ((ice-9 rdelim) #:select (read-line)) |
| 88 | + ((ice-9 regex) #:select (regexp-match? string-match))) |
| 89 | + |
| 90 | + ;; Assume that this script will be installed under bin/. |
| 91 | + (define %basedir (dirname (dirname (current-filename)))) |
| 92 | + |
| 93 | + (define (cpu-feature-line? string) |
| 94 | + (string-prefix? "flags" string)) |
| 95 | + |
| 96 | + (define (contains-word? word string) |
| 97 | + (regexp-match? |
| 98 | + (string-match (string-join `("\\<" ,word "\\>") "") |
| 99 | + string))) |
| 100 | + |
| 101 | + (define (has-cpu-feature? feature) |
| 102 | + (with-input-from-file "/proc/cpuinfo" |
| 103 | + (lambda () |
| 104 | + (catch 'found |
| 105 | + (lambda () |
| 106 | + (let loop ((line (read-line))) |
| 107 | + (cond ((eof-object? line) #f) |
| 108 | + ((and (cpu-feature-line? line) |
| 109 | + (contains-word? feature line)) |
| 110 | + (throw 'found)) |
| 111 | + (else (loop (read-line)))))) |
| 112 | + (const #t))))) |
| 113 | + |
| 114 | + (let* ((jconsole (string-append %basedir "/libexec/j/jconsole")) |
| 115 | + (libj (format #f "~a/lib/j/libj-~a.so" %basedir |
| 116 | + (cond ((has-cpu-feature? "avx2") "avx2") |
| 117 | + ((has-cpu-feature? "avx") "avx") |
| 118 | + (else "")))) |
| 119 | + (jprofile (string-append %basedir "/etc/j/profile.ijs"))) |
| 120 | + (apply execl jconsole "ijconsole" "-lib" libj "-jprofile" jprofile |
| 121 | + (cdr (command-line))))))) |
| 122 | + |
| 123 | + |
| 124 | +(define* (j-package #:key (builder (git-user)) |
| 125 | + (version (git-version)) |
| 126 | + (type 'devel) |
| 127 | + (extra-inputs '()) |
| 128 | + (extra-envars '())) |
| 129 | + (package |
| 130 | + (name "j") |
| 131 | + (version version) |
| 132 | + (source (local-file %source-dir #:recursive? #t #:select? git-file?)) |
| 133 | + (build-system gnu-build-system) |
| 134 | + (native-inputs `(("clang-toolchain" ,clang-toolchain))) |
| 135 | + (inputs (cons* `("libedit" ,libedit) |
| 136 | + `("libomp" ,libomp) |
| 137 | + `("ijconsole" ,(ijconsole)) |
| 138 | + extra-inputs)) |
| 139 | + (arguments |
| 140 | + `(#:tests? #f |
| 141 | + #:modules (((ice-9 ftw) #:select (scandir)) |
| 142 | + ((ice-9 popen) #:select (open-pipe* close-pipe)) |
| 143 | + ((ice-9 regex) #:select (match:substring string-match)) |
| 144 | + ((ice-9 threads) #:select (parallel par-for-each)) |
| 145 | + ((srfi srfi-26) #:select (cut)) |
| 146 | + ((srfi srfi-1) #:select (fold)) |
| 147 | + ,@%gnu-build-system-modules) |
| 148 | + #:phases |
| 149 | + ;; Upstream's build system consists of ad-hoc scripts that build |
| 150 | + ;; build up (very complicated) environment variables to pass to make. |
| 151 | + ;; The basic build process looks like this: |
| 152 | + ;; |
| 153 | + ;; 1) Copy jsrc/jversion-x.h to jsrc/jversion.h and edit values; |
| 154 | + ;; 2) Set jplatform and j64x environment variables; |
| 155 | + ;; 3) Run make2/build_jconsole.sh and make2/build_libj.sh; |
| 156 | + ;; |
| 157 | + ;; However, upstream expects users to run J directly from the source |
| 158 | + ;; directory; they do not supply a make `install' target. Thus it |
| 159 | + ;; takes some massaging to install files in FHS-style directories. |
| 160 | + (modify-phases %standard-phases |
| 161 | + ;; In particular, we have to set up |
| 162 | + ;; |
| 163 | + ;; 1) jsrc/jversion.h as in a typical build; |
| 164 | + ;; 2) jlibrary/bin/profilex.ijs to point to writable directories; |
| 165 | + ;; 3) make2/build_*.sh to respect standard build conventions; |
| 166 | + ;; 4) jsrc/jconsole.c to fix libedit dlopen; and |
| 167 | + ;; 5) Hard coded references to addons directory. |
| 168 | + (replace 'configure |
| 169 | + (lambda* (#:key target inputs outputs #:allow-other-keys) |
| 170 | + (let* ((clang-toolchain (assoc-ref inputs "clang-toolchain")) |
| 171 | + (clang (string-append clang-toolchain "/bin/clang")) |
| 172 | + (libedit (assoc-ref inputs "libedit")) |
| 173 | + (out (assoc-ref outputs "out"))) |
| 174 | + ;; Set up build constants |
| 175 | + (copy-file "jsrc/jversion-x.h" "jsrc/jversion.h") |
| 176 | + (substitute* "jsrc/jversion.h" |
| 177 | + (("^#define jversion.*$") |
| 178 | + (format #f "#define jversion ~s\n" ,version)) |
| 179 | + (("^#define jtype.*$") |
| 180 | + (format #f "#define jtype ~s\n" (symbol->string ',type))) |
| 181 | + (("^#define jbuilder.*$") |
| 182 | + (format #f "#define jbuilder ~s\n" ,builder))) |
| 183 | + ;; Create profilex.ijs overrides to point to the correct |
| 184 | + ;; store items. Note that we set ~install and ~addons |
| 185 | + ;; directories to reside under ~user to allow installing |
| 186 | + ;; and loading addons. TODO: Guix-ify J addons as well. |
| 187 | + (call-with-output-file "jlibrary/bin/profilex.ijs" |
| 188 | + (lambda (port) |
| 189 | + (display |
| 190 | + (string-join |
| 191 | + (list |
| 192 | + "share=. '/share/j',~ ({.~ _2 { I.@:=&'/') BINPATH" |
| 193 | + "system=. share,'/system'" |
| 194 | + "tools=. share,'/tools'" |
| 195 | + ;; Upstream defaults to spamming $HOME with |
| 196 | + ;; unhidden userdata directories. Set this to be |
| 197 | + ;; $HOME/.j/<jtype>/<jversion> instead |
| 198 | + "'jtype jversion'=. (3&{,{.) <;._2 ,&'/' 9!:14''" |
| 199 | + "jversion=. ({.~ i.&'-') jversion" |
| 200 | + "jsuffix=. >@{&('';'-beta') jtype -: 'beta'" |
| 201 | + "user=. home,'/.j/',jversion,jsuffix" |
| 202 | + "addons=. user,'/addons'" |
| 203 | + "break=. user,'/break'" |
| 204 | + "config=. user,'/config'" |
| 205 | + "install=. user,'/install'" |
| 206 | + "snap=. user,'/snap'" |
| 207 | + "temp=. user,'/temp'" |
| 208 | + "\n") |
| 209 | + "\n") |
| 210 | + port))) |
| 211 | + ;; Munge the build scripts into reason: |
| 212 | + ;; 1. Short-circuit the fragile compiler detection; |
| 213 | + ;; 2. Make sure to include our CFLAGS and LFLAGS; and |
| 214 | + ;; 3. Propagate script errors to top level. |
| 215 | + (for-each |
| 216 | + (lambda (file) |
| 217 | + (with-directory-excursion "make2" |
| 218 | + (substitute* file |
| 219 | + ;; The `compiler' variable doesn't point to the actual |
| 220 | + ;; compiler. It is just a switch to tell the build |
| 221 | + ;; scripts whether to use gcc- or clang-specific |
| 222 | + ;; flags. |
| 223 | + (("^compiler=.*$") "compiler=clang\n") |
| 224 | + (("^LDFLAGS=\"" def) (string-append def "$LDFLAGS ")) |
| 225 | + (("^(common=\")(\\$USETHREAD.*)$" _ def rest) |
| 226 | + (string-append def "$CFLAGS " rest)) |
| 227 | + (("^#!.*" shebang) |
| 228 | + (string-append shebang "set -o errexit\n"))))) |
| 229 | + '("build_jconsole.sh" "build_libj.sh")) |
| 230 | + ;; The jconsole manually loads libedit with dlopen. The path |
| 231 | + ;; must be absolute to correctly point to our input. |
| 232 | + (substitute* "jsrc/jconsole.c" |
| 233 | + (("libedit\\.so\\.[0-9]" so-file) |
| 234 | + (format #f "~a/lib/~a" libedit so-file))) |
| 235 | + ;; The ~addons/dev directory supplies tentative J-script |
| 236 | + ;; definitions of new J engine functionality. Since we point |
| 237 | + ;; ~addons under the ~user directory, we move it under |
| 238 | + ;; ~system instead, which sits as-is in the output. |
| 239 | + (with-directory-excursion "jsrc" |
| 240 | + (for-each |
| 241 | + (lambda (file) |
| 242 | + (substitute* file (("~addons/dev") "~system/dev"))) |
| 243 | + (scandir "." |
| 244 | + (lambda (f) (eq? (stat:type (stat f)) 'regular))))) |
| 245 | + ;; Implementation of 9!:14 records build time which breaks |
| 246 | + ;; build reproducibility. Note that upstream code depends on |
| 247 | + ;; the exact format of these strings, so we need to mimic the |
| 248 | + ;; standard. |
| 249 | + (substitute* "jsrc/j.c" |
| 250 | + (("__DATE__") "\"Jan 01 1970\"") |
| 251 | + (("__TIME__") "\"00:00:00\"")) |
| 252 | + ;; Upstream recommends using clang, with GCC support being |
| 253 | + ;; second-class, often resulting in build failures. |
| 254 | + (setenv "CC" clang)))) |
| 255 | + ;; The build output depends primarily on the values of the |
| 256 | + ;; `jplatform' and `j64x' environment variables. If the target is |
| 257 | + ;; ARM, then `jplatform' is "raspberry", otherwise it is `linux'. |
| 258 | + ;; In addition to 32- and 64- bit versions, `j64x' controlls |
| 259 | + ;; whether AVX or AVX2 variants of libj are built. |
| 260 | + ;; |
| 261 | + ;; However, build targets are not fine-grained enough to |
| 262 | + ;; distinguish between CPU features. Thus we build and install all |
| 263 | + ;; variants of libj, expecting jconsole to be called with a wrapper |
| 264 | + ;; script that detects AVX features and loads the appropriate libj |
| 265 | + ;; at runtime. |
| 266 | + (replace 'build |
| 267 | + (lambda _ |
| 268 | + (setenv "USE_OPENMP" "1") |
| 269 | + (setenv "USE_THREAD" "1") |
| 270 | + (for-each (lambda (var-val) (apply setenv var-val)) |
| 271 | + (quote ,extra-envars)) |
| 272 | + ;; The build scripts assume that PWD is make2. |
| 273 | + (with-directory-excursion "make2" |
| 274 | + (let* ((platform ,(if (target-arm?) "raspberry" "linux")) |
| 275 | + (jplat (string-append "jplatform=" platform)) |
| 276 | + (target-bit ,(if (target-64bit?) "64" "32")) |
| 277 | + (jbit (string-append "j64x=" "j" target-bit)) |
| 278 | + (jbit-avx (string-append jbit "avx")) |
| 279 | + (jbit-avx2 (string-append jbit "avx2"))) |
| 280 | + (parallel |
| 281 | + ;; Since jconsole doesn't depend on AVX features, we just |
| 282 | + ;; build it once. |
| 283 | + (invoke "env" jplat jbit "./build_jconsole.sh") |
| 284 | + (invoke "env" jplat jbit "./build_libj.sh") |
| 285 | + (if ,(target-64bit?) |
| 286 | + (parallel |
| 287 | + (invoke "env" jplat jbit-avx "./build_libj.sh") |
| 288 | + (invoke "env" jplat jbit-avx2 |
| 289 | + "./build_libj.sh")))))))) |
| 290 | + ;; The test suite is expected to be run as follows for each variant |
| 291 | + ;; of libj that we build: |
| 292 | + ;; |
| 293 | + ;; $ echo 'RUN ddall' | jconsole test/tsu.ijs |
| 294 | + ;; |
| 295 | + ;; This requires a working jconsole with accessible jlibrary files. |
| 296 | + ;; We simply place these all under test/bin. |
| 297 | + (replace 'check |
| 298 | + (lambda* (#:key tests? #:allow-other-keys) |
| 299 | + (when tests? |
| 300 | + (let ((jplatform ,(if (target-arm?) "raspberry" "linux"))) |
| 301 | + (mkdir-p "test/bin") |
| 302 | + (for-each |
| 303 | + (lambda (dir) |
| 304 | + (let ((source (string-append "jlibrary/" dir)) |
| 305 | + (dest (string-append "test/bin/" dir))) |
| 306 | + (begin |
| 307 | + (mkdir-p dest) |
| 308 | + (copy-recursively source dest)))) |
| 309 | + '("system" "tools" "addons")) |
| 310 | + ;; The jlibrary/dev directory only sometimes exists, but |
| 311 | + ;; needs to be copied into the ~system directory when it |
| 312 | + ;; does. |
| 313 | + (for-each |
| 314 | + (lambda (dev-dir) |
| 315 | + (if (access? dev-dir R_OK) |
| 316 | + (copy-recursively dev-dir "test/bin/system/dev"))) |
| 317 | + '("jlibrary/dev" "jlibrary/addons/dev")) |
| 318 | + (par-for-each |
| 319 | + (lambda (dir) |
| 320 | + (let* ((jbin (string-append "bin/" jplatform)) |
| 321 | + (jbit ,(if (target-64bit?) "j64" "j32")) |
| 322 | + (jconsole (string-append jbin "/" jbit |
| 323 | + "/jconsole")) |
| 324 | + (source (string-append jbin "/" dir)) |
| 325 | + (dest (string-append "test/bin/" dir))) |
| 326 | + (begin |
| 327 | + (mkdir-p dest) |
| 328 | + (copy-recursively source dest) |
| 329 | + (install-file "jlibrary/bin/profile.ijs" dest) |
| 330 | + (install-file jconsole dest) |
| 331 | + (let* ((jc (string-append dest "/jconsole")) |
| 332 | + (tests "test/tsu.ijs") |
| 333 | + (port (open-pipe* OPEN_WRITE jc tests))) |
| 334 | + (display "RUN ddall\n" port) |
| 335 | + (when (not (zero? (status:exit-val |
| 336 | + (close-pipe port)))) |
| 337 | + (error "Some J build tests failed.")))))) |
| 338 | + (scandir (string-append "bin/" jplatform) |
| 339 | + (negate (cut member <> '("." ".."))))) |
| 340 | + #t)))) |
| 341 | + ;; Now that everything is built, installation is fairly |
| 342 | + ;; straightforward, following FHS conventions. The only quirk is |
| 343 | + ;; that we install jconsole under /libexec to make room for the |
| 344 | + ;; wrapper replacement under /bin. |
| 345 | + (replace 'install |
| 346 | + (lambda* (#:key outputs inputs #:allow-other-keys) |
| 347 | + (let* ((jplat ,(if (target-arm?) "raspberry" "linux")) |
| 348 | + (jbit ,(if (target-64bit?) "j64" "j32")) |
| 349 | + (interp (string-join `("bin" ,jplat ,jbit "jconsole") "/")) |
| 350 | + (ijconsole (assoc-ref inputs "ijconsole")) |
| 351 | + (vname (match:substring (string-match "[0-9]+" ,version))) |
| 352 | + (out (assoc-ref outputs "out")) |
| 353 | + (bin (string-append out "/bin")) |
| 354 | + (etc (string-append out "/etc/j")) |
| 355 | + (lib (string-append out "/lib/j")) |
| 356 | + (libexec (string-append out "/libexec/j")) |
| 357 | + (share (string-append out "/share/j")) |
| 358 | + (system (string-append share "/system")) |
| 359 | + (dev (string-append system "/dev"))) |
| 360 | + (mkdir-p bin) |
| 361 | + (copy-file ijconsole (string-append bin "/ijconsole-" vname)) |
| 362 | + (mkdir-p lib) |
| 363 | + (for-each |
| 364 | + (lambda (jarch) |
| 365 | + (let* ((jbin (string-join `("bin" ,jplat ,jarch) "/")) |
| 366 | + (javx-match (string-match "avx.*" jarch)) |
| 367 | + (javx (if (not javx-match) "" |
| 368 | + (match:substring javx-match))) |
| 369 | + (sep (if javx-match "-" "")) |
| 370 | + (source (string-append jbin "/libj.so")) |
| 371 | + (dest (format #f "~a/libj~a~a.so" lib sep javx))) |
| 372 | + (copy-file source dest))) |
| 373 | + (scandir (string-append "bin/" jplat) |
| 374 | + (negate (cut member <> '("." ".."))))) |
| 375 | + (install-file interp libexec) |
| 376 | + (copy-recursively "jlibrary/system" system) |
| 377 | + (for-each |
| 378 | + (lambda (source-dev) |
| 379 | + (if (access? source-dev R_OK) |
| 380 | + (copy-recursively source-dev dev))) |
| 381 | + '("jlibrary/dev" "jlibrary/addons/dev")) |
| 382 | + (install-file "jlibrary/bin/profile.ijs" etc) |
| 383 | + (install-file "jlibrary/bin/profilex.ijs" etc))))))) |
| 384 | + (home-page "https://www.jsoftware.com/") |
| 385 | + (synopsis "Ascii-only, array programming language in the APL family") |
| 386 | + (description |
| 387 | + "J is a high-level, general-purpose programming language that is |
| 388 | +particularly suited to the mathematical, statistical, and logical analysis of |
| 389 | +data. It is a powerful tool for developing algorithms and exploring problems |
| 390 | +that are not already well understood.") |
| 391 | + (license license:gpl3+))) |
| 392 | + |
| 393 | +(j-package #:extra-inputs `(("sleef" ,sleef)) |
| 394 | + #:extra-envars `(("USE_SLEEF_SRC" "0") |
| 395 | + ("LDFLAGS" "-lsleef"))) |
0 commit comments