[bug#55248] [PATCH 7/7] gnu: chez-scheme-for-system: Adjust support logic.

[Liliana Marie Prikler]

Am Dienstag, dem 03.05.2022 um 14:33 -0400 schrieb Philip McGrath:
> This is a follow-up to commit
> b8fc9169515ef1a6d6037c84e30ad308e5418b6f:
> see <https://issues.guix.gnu.org/54292>. Thanks to Liliana Marie
> Prikler for pointing out various issues, e.g. that being able to
> represent a Nix system as a Chez Scheme machine type does not
> necessarily mean the system is supported!
The issue in that commit is a different one: nix-system->chez-machine
can fail if there's no conversion.  Anyway...

> [...]
> ;; 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))
Does it make sense to require 'threads always?

>  
> -(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))))
> -
The replacement code should go here for readability imho.  At the very
least I was confused why this was first above and now below.

>  (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)))
> +
For the sake of completeness, we might want to still have nix-system-
>chez-machine (with a threaded? argument) defined in terms of target-
chez-arch and target-chez-os.  See 6/7 for motivation.

>  
>  ;;
>  ;; 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?
I'd say "XXX: reportedly broken, needs checking"
>        (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 <>)))
Yup, that's simpler.
>               %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))
All in all, the individual logic of this patch seems fine, but overall
it appears as though it's doing three separate things (chez-scheme-for-
system, chez features, racket-cs stuff).  IMO it would make sense to
split this patch according to those lines.  WDYT?

Patches 2-5 mostly LGTM, at least I don't see any glaring issues in
this iteration.

Cheers