@@ -315,7 +315,8 @@ (define* (glibc-dynamic-linker
(%current-system))))
"Return the name of Glibc's dynamic linker for SYSTEM."
;; See the 'SYSDEP_KNOWN_INTERPRETER_NAMES' cpp macro in libc.
- (let ((platform (lookup-platform-by-system system)))
+ (let ((platform (false-if-platform-not-found
+ (lookup-platform-by-system system))))
(cond
((platform? platform)
(platform-glibc-dynamic-linker platform))
@@ -22,6 +22,8 @@ (define-module (guix platform)
#:use-module (guix records)
#:use-module (guix ui)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
#:export (platform
platform?
platform-target
@@ -29,6 +31,10 @@ (define-module (guix platform)
platform-linux-architecture
platform-glibc-dynamic-linker
+ &platform-not-found-error
+ platform-not-found-error?
+ false-if-platform-not-found
+
platform-modules
platforms
lookup-platform-by-system
@@ -70,6 +76,20 @@ (define-record-type* <platform> platform make-platform
(default #false))
(glibc-dynamic-linker platform-glibc-dynamic-linker))
+
+;;;
+;;; Exceptions.
+;;;
+(define-condition-type &platform-not-found-error &error
+ platform-not-found-error?
+ (target-or-system platform-not-found-error-target-or-system))
+
+(define-syntax-rule (false-if-platform-not-found exp)
+ "Evaluate EXP but return #f if it raises a platform-not-found-error?
+exception."
+ (guard (ex ((platform-not-found-error? ex) #f))
+ exp))
+
;;;
;;; Platforms.
@@ -94,23 +114,32 @@ (define platforms
(platform-modules)))))
(define (lookup-platform-by-system system)
- "Return the platform corresponding to the given SYSTEM."
- (find (lambda (platform)
- (let ((s (platform-system platform)))
- (and (string? s) (string=? s system))))
- (platforms)))
+ "Return the platform corresponding to the given SYSTEM. Raise
+&PLATFORM-NOT-FOUND-ERROR when no platform could be found."
+ (or (find (lambda (platform)
+ (let ((s (platform-system platform)))
+ (and (string? s) (string=? s system))))
+ (platforms))
+ (raise-exception (condition (&platform-not-found-error
+ (target-or-system system))))))
(define (lookup-platform-by-target target)
- "Return the platform corresponding to the given TARGET."
- (find (lambda (platform)
- (let ((t (platform-target platform)))
- (and (string? t) (string=? t target))))
- (platforms)))
+ "Return the platform corresponding to the given TARGET. Raise
+&PLATFORM-NOT-FOUND-ERROR when no platform could be found."
+ (or (find (lambda (platform)
+ (let ((t (platform-target platform)))
+ (and (string? t) (string=? t target))))
+ (platforms))
+ (raise-exception (condition (&platform-not-found-error
+ (target-or-system target))))))
(define (lookup-platform-by-target-or-system target-or-system)
- "Return the platform corresponding to the given TARGET or SYSTEM."
- (or (lookup-platform-by-target target-or-system)
- (lookup-platform-by-system target-or-system)))
+ "Return the platform corresponding to the given TARGET or SYSTEM. Raise
+&PLATFORM-NOT-FOUND-ERROR when no platform could be found."
+ (or (false-if-platform-not-found (lookup-platform-by-target target-or-system))
+ (false-if-platform-not-found (lookup-platform-by-system target-or-system))
+ (raise-exception (condition (&platform-not-found-error
+ (target-or-system target-or-system))))))
(define (platform-system->target system)
"Return the target matching the given SYSTEM if it exists or false
This was motivated by #60786, which produced a cryptic, hard to understand backtrace. Given the following reproducer: (use-modules (guix packages) (gnu packages cross-base)) (define linux-libre-headers-cross-mips64el-linux-gnuabi64 (cross-kernel-headers "mips64el-linux-gnuabi64")) (package-arguments linux-libre-headers-cross-mips64el-linux-gnuabi64) Before this change: ice-9/boot-9.scm:1685:16: In procedure raise-exception: In procedure struct-vtable: Wrong type argument in position 1 (expecting struct): #f After this change: ice-9/boot-9.scm:1685:16: In procedure raise-exception: ERROR: 1. &platform-not-found-error: "mips64el-linux-gnuabi64" * guix/platform.scm (&platform-not-found-error): New condition. (platform-not-found-error?): New predicate. (false-if-platform-not-found): New syntax. (lookup-platform-by-system): Raise an exception when no platform is found. Update documentation. (lookup-platform-by-target): Likewise. (lookup-platform-by-target-or-system): Likewise, and guard lookup calls with false-if-platform-not-found. * gnu/packages/bootstrap.scm (glibc-dynamic-linker): Handle lookup-platform-by-system call to preserve existing behavior. --- Changes in v4: - Use (srfi srfi-35) condition instead of (ice-9 exceptions) - Add a target-or-system field to the condition type for extra information Changes in v3: - Use false-if-platform-not-found instead of false-if-exception in (gnu packages bootstrap) - Do not export make-platform-not-found-error constructor Changes in v2: - Add false-if-platform-not-found syntax - Use it while evaluating lookup-platform-by-target-or-system gnu/packages/bootstrap.scm | 3 ++- guix/platform.scm | 55 +++++++++++++++++++++++++++++--------- 2 files changed, 44 insertions(+), 14 deletions(-)