Toggle diff (346 lines)
diff --git a/gnu/packages/chez.scm b/gnu/packages/chez.scm
index ea53cf5774..a61146eb02 100644
--- a/gnu/packages/chez.scm
+++ b/gnu/packages/chez.scm
@@ -48,9 +48,7 @@ (define-module (gnu packages chez)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:export (chez-scheme-for-system
- nix-system->chez-machine
- chez-machine->nonthreaded
- chez-machine->threaded
+ racket-cs-native-supported-system?
unpack-nanopass+stex))
;; Commentary:
@@ -73,96 +71,17 @@ (define* (chez-scheme-for-system #:optional
(%current-system))))
"Return 'chez-scheme' unless only 'chez-scheme-for-racket' supports SYSTEM,
including support for native threads."
- (if (or
- ;; full support upstream
- (and=> (chez-upstream-features-for-system system)
- (cut memq 'threads <>))
- ;; no support anywhere
- (not (nix-system->chez-machine system)))
+ (if (and=> (chez-upstream-features-for-system system)
+ (lambda (features)
+ (every (cut memq <> features)
+ '(threads
+ ;; We can cross-compile for platforms without
+ ;; bootstrap bootfiles, but we can't self-host
+ ;; on them short of adding more binary seeds.
+ bootstrap-bootfiles))))
chez-scheme
chez-scheme-for-racket))
-(define (chez-machine->nonthreaded machine)
- "Given a string MACHINE naming a Chez Scheme machine type, returns a string
-naming the nonthreaded machine type for the same architecture and OS as
-MACHINE. The returned string may share storage with MACHINE."
- ;; Chez Scheme documentation consistently uses "nonthreaded" rather than
- ;; e.g. "unthreaded"
- (if (eqv? #\t (string-ref machine 0))
- (substring machine 1)
- machine))
-(define (chez-machine->threaded machine)
- "Like @code{chez-machine->nonthreaded}, but returns the threaded machine
-type."
- (if (eqv? #\t (string-ref machine 0))
- machine
- (string-append "t" machine)))
-
-;; Based on the implementation from raco-cross-lib/private/cross/platform.rkt
-;; in https://github.com/racket/raco-cross.
-;; For supported platforms, refer to release_notes/release_notes.stex in the
-;; upstream Chez Scheme repository or to racket/src/ChezScheme/README.md
-;; in https://github.com/racket/racket.
-(define %nix-arch-to-chez-alist
- `(("x86_64" . "a6")
- ("i386" . "i3")
- ("aarch64" . "arm64")
- ("armhf" . "arm32") ;; Chez supports ARM v6+
- ("ppc" . "ppc32")))
-(define %nix-os-to-chez-alist
- `(("w64-mingw32" . "nt")
- ("darwin" . "osx")
- ("linux" . "le")
- ("freebsd" . "fb")
- ("openbsd" . "ob")
- ("netbsd" . "nb")
- ("solaris" . "s2")))
-
-(define (chez-machine->nix-system machine)
- "Return the Nix system type corresponding to the Chez Scheme machine type
-MACHINE. If MACHINE is not a string representing a known machine type, an
-exception is raised. This function does not distinguish between threaded and
-nonthreaded variants of MACHINE.
-
-Note that this function only handles Chez Scheme machine types in the
-strictest sense, not other kinds of descriptors sometimes used in place of a
-Chez Scheme machine type by Racket, such as @code{\"pb\"}, @code{#f}, or
-@code{\"racket\"}. (When using such extensions, the Chez Scheme machine type
-for the host system is often still relevant.)"
- (let ((machine (chez-machine->nonthreaded machine)))
- (let find-arch ((alist %nix-arch-to-chez-alist))
- (match alist
- (((nix . chez) . alist)
- (if (string-prefix? chez machine)
- (string-append
- nix "-" (let ((machine-os
- (substring machine (string-length chez))))
- (let find-os ((alist %nix-os-to-chez-alist))
- (match alist
- (((nix . chez) . alist)
- (if (equal? chez machine-os)
- nix
- (find-os alist)))))))
- (find-arch alist)))))))
-
-(define* (nix-system->chez-machine #:optional
- (system (or (%current-target-system)
- (%current-system))))
- "Return the Chez Scheme machine type corresponding to the Nix system
-identifier SYSTEM, or @code{#f} if the translation of SYSTEM to a Chez Scheme
-machine type is undefined.
-
-It is unspecified whether the resulting string will name a threaded or a
-nonthreaded machine type: when the distinction is relevant, use
-@code{chez-machine->nonthreaded} or @code{chez-machine->threaded} to adjust
-the result."
- (let* ((hyphen (string-index system #\-))
- (nix-arch (substring system 0 hyphen))
- (nix-os (substring system (+ 1 hyphen)))
- (chez-arch (assoc-ref %nix-arch-to-chez-alist nix-arch))
- (chez-os (assoc-ref %nix-os-to-chez-alist nix-os)))
- (and chez-arch chez-os (string-append chez-arch chez-os))))
-
(define* (chez-upstream-features-for-system #:optional
(system
(or (%current-target-system)
@@ -172,20 +91,150 @@ (define* (chez-upstream-features-for-system #:optional
does not support SYSTEM at all.
If native threads are supported, the returned list will include
-@code{'threads}. Other feature symbols may be added in the future."
+@code{'threads}. If bootstrap bootfiles for SYSTEM are distributed in the
+upstream Chez Scheme repository, the returned list will include
+@code{'bootstrap-bootfiles}. Other feature symbols may be added in the
+future."
+ (let ((chez-arch (target-chez-arch system))
+ (chez-os (target-chez-os system)))
+ (and=> (assoc-ref %chez-features-table chez-os)
+ (cut assoc-ref <> chez-arch))))
+
+(define* (racket-cs-native-supported-system? #:optional
+ (system
+ (or (%current-target-system)
+ (%current-system))))
+ "Can Racket's variant of Chez Scheme generate native code for SYSTEM?
+Otherwise, SYSTEM can use only the ``portable bytecode'' backends."
+ (let ((chez-arch (target-chez-arch system))
+ (chez-os (target-chez-os system)))
+ (and (and=> (assoc-ref %chez-features-table chez-os)
+ ;; NOT assoc-ref: supported even if cdr is #f
+ (cut assoc chez-arch <>))
+ #t)))
+
+(define %chez-features-table
+ ;; An alist of alists mapping:
+ ;; os -> arch -> (or/c #f (listof symbol?))
+ ;; where:
+ ;; - `os` is a string for the OS part of a Chez Scheme machine type; and
+ ;; - `arch` is a string for the architecture part of a Chez machine type.
+ ;;
+ ;; The absence of an entry for a given arch--os pair means that neither
+ ;; upstream Chez Scheme nor the Racket variant can generate native code for
+ ;; that system. (The Racket variant can still provide support via its
+ ;; ``portable bytecode'' backends and optional compilation to C.) A value
+ ;; of `#f` means that upstream Chez Scheme does not support the arch--os
+ ;; pair at all, but the Racket variant does. A list has the same meaning as
+ ;; a result from `chez-upstream-features-for-system`.
+ ;;
+ ;; The arch--os pairs marked "commented out" have been commented out in the
+ ;; STeX source for the upstream release notes since the initial release as
+ ;; free software, but they are reported to work and/or have been described
+ ;; as supported by upstream maintainers.
+ ;;
+ ;; For this overall approach to make sense, we assume that Racket's variant
+ ;; of Chez Scheme can generate native code for a superset of the platforms
+ ;; supported upstream, supports threads on all platforms it supports at all
+ ;; (because they are needed for Racket), and doesn't need bootstrap
+ ;; bootfiles. Those assumptions have held for several years.
+ '(;; Linux
+ ("le"
+ ("i3" threads bootstrap-bootfiles)
+ ("a6" threads bootstrap-bootfiles)
+ ("arm32" bootstrap-bootfiles)
+ ("arm64" . #f)
+ ("ppc32" threads))
+ ;; FreeBSD
+ ("fb"
+ ("i3" threads) ;; commented out
+ ("a6" threads) ;; commented out
+ ("arm32" . #f)
+ ("arm64" . #f)
+ ("ppc32" . #f))
+ ;; OpenBSD
+ ("ob"
+ ("i3" threads) ;; commented out
+ ("a6" threads) ;; commented out
+ ("arm32" . #f)
+ ("arm64" . #f)
+ ("ppc32" . #f))
+ ;; NetBSD
+ ("nb"
+ ("i3" threads) ;; commented out
+ ("a6" threads) ;; commented out
+ ("arm32" . #f)
+ ("arm64" . #f)
+ ("ppc32" . #f))
+ ;; OpenSolaris / OpenIndiana / Illumos
+ ("s2"
+ ("i3" threads) ;; commented out
+ ("a6" threads)) ;; commented out
+ ;; Windows
+ ("nt"
+ ("i3" threads bootstrap-bootfiles)
+ ("a6" threads bootstrap-bootfiles)
+ ;; ^ threads "experiemental", but reportedly fine
+ ("arm64" . #f))
+ ;; Darwin
+ ("osx"
+ ("i3" threads bootstrap-bootfiles)
+ ("a6" threads bootstrap-bootfiles)
+ ("arm64" . #f)
+ ("ppc32" . #f))))
+
+(define* (target-chez-arch #:optional (system
+ (or (%current-target-system)
+ (%current-system))))
+ "Return a string representing the architecture of SYSTEM as used in Chez
+Scheme machine types, or '#f' if none is defined."
(cond
- ((not (nix-system->chez-machine system))
- #f)
+ ((target-x86-64? system)
+ "a6")
+ ((target-x86-32? system)
+ "i3")
((target-aarch64? system)
- #f)
+ "arm64")
((target-arm32? system)
- (and (target-linux? system)
- '()))
+ "arm32")
+ ((target-ppc64le? system)
+ #f)
((target-ppc32? system)
- (and (target-linux? system)
- '(threads)))
+ "ppc32")
+ ((target-riscv64? system)
+ #f)
(else
- '(threads))))
+ #f)))
+
+(define* (target-chez-os #:optional (system (or (%current-target-system)
+ (%current-system))))
+ "Return a string representing the operating system kernel of SYSTEM as used
+in Chez Scheme machine types, or '#f' if none is defined."
+ ;; e.g. "le" includes both GNU/Linux and Android
+ (cond
+ ((target-linux? system)
+ "le")
+ ((target-hurd? system)
+ #f)
+ ((target-mingw? system)
+ "nt")
+ ;; missing (guix utils) predicates
+ ;; cf. https://github.com/NixOS/nixpkgs/blob/master/lib/systems/doubles.nix
+ ((string-suffix? "-darwin" system)
+ "osx")
+ ((string-suffix? "-freebsd" system)
+ "fb")
+ ((string-suffix? "-openbsd" system)
+ "ob")
+ ((string-suffix? "-netbsd" system)
+ "nb")
+ ;; Nix says "x86_64-solaris", but accommodate "-solaris2"
+ ((string-contains system "solaris")
+ "s2")
+ ;; unknown
+ (else
+ #f)))
+
;;
;; Chez Scheme:
@@ -365,14 +414,9 @@ (define-public chez-scheme
((pth)
(symlink pth
"csug.pdf")))))))))
- ;; Chez Scheme does not have a MIPS backend.
- ;; FIXME: Debian backports patches to get armhf working.
- ;; We should too. It is the Chez machine type arm32le
- ;; (no threaded version upstream yet, though there is in
- ;; Racket's fork), more specifically (per the release notes) ARMv6.
(supported-systems
(delete
- "armhf-linux" ;; <-- should work, but reportedly broken
+ "armhf-linux" ;; XXX is this still broken?
(filter chez-upstream-features-for-system
%supported-systems)))
(home-page "https://cisco.github.io/ChezScheme/")
@@ -418,7 +462,9 @@ (define-public chez-scheme-for-racket
(add-after 'unpack 'chdir
(lambda args
(chdir "racket/src/ChezScheme"))))))))
- (supported-systems (filter nix-system->chez-machine
+ ;; TODO: How to build pbarch/pbchunks for other systems?
+ ;; See https://racket.discourse.group/t/950
+ (supported-systems (filter racket-cs-native-supported-system?
%supported-systems))
(home-page "https://github.com/racket/ChezScheme")
;; ^ This is downstream of https://github.com/racket/racket,
@@ -471,16 +517,9 @@ (define-public chez-scheme-bootstrap-bootfiles
(list #:install-plan
#~`(("boot/" "lib/chez-scheme-bootfiles"))))
(supported-systems
- ;; Upstream only distributes pre-built bootfiles for
- ;; arm32le and t?(i3|a6)(le|nt|osx)
(filter (lambda (system)
- (let ((machine (and=> (nix-system->chez-machine system)
- chez-machine->nonthreaded)))
- (or (equal? "arm32le" machine)
- (and machine
- (member (substring machine 0 2) '("i3" "a6"))
- (or-map (cut string-suffix? <> machine)
- '("le" "nt" "osx"))))))
+ (and=> (chez-upstream-features-for-system system)
+ (cut memq 'bootstrap-bootfiles <>)))
%supported-systems))
(synopsis "Chez Scheme bootfiles (binary seed)")
(description
diff --git a/gnu/packages/racket.scm b/gnu/packages/racket.scm
index 2f4f7cebd8..41f45f4215 100644
--- a/gnu/packages/racket.scm
+++ b/gnu/packages/racket.scm
@@ -190,8 +190,11 @@ (define-module (gnu packages racket)
(define* (racket-vm-for-system #:optional
(system (or (%current-target-system)
(%current-system))))
- "Return 'racket-vm-cs' if it supports SYSTEM; 'racket-vm-bc' otherwise."
- (if (nix-system->chez-machine system)
+ "Return 'racket-vm-cs' we are able to build it for SYSTEM; 'racket-vm-bc'
+otherwise."
+ ;; Once we figure out the issues in https://racket.discourse.group/t/950,
+ ;; we can use 'racket-vm-cs' everywhere.
+ (if (racket-cs-native-supported-system? system)
racket-vm-cs
racket-vm-bc))
--
2.32.0
