kreyren/guix-kreyren
1
0
Fork 0
Code Issues 1 Pull Requests 1 Releases Activity

platform: Add discovery support.

Browse Source 
* gnu/platform.scm (platform-modules, systems, targets,
lookup-platform-by-system, lookup-platform-by-target,
lookup-platform-by-target-or-system
platform-system->target,
platform-target->system): New procedures.
(%platforms): New variable.

Signed-off-by: Mathieu Othacehe <othacehe@gnu.org>
This commit is contained in:
Mathieu Othacehe 2022-05-02 12:56:16 +02:00
parent 31f7696be4
commit 4f2320f79d
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
1 changed files with 98 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

101
gnu/platform.scm
View File

@ -17,22 +17,117 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu platform)
#:use-module (guix discovery)
#:use-module (guix memoization)
#:use-module (guix records)
#:use-module (guix ui)
#:use-module (srfi srfi-1)
#:export (platform
platform?
platform-target
platform-system
platform-linux-architecture))
platform-linux-architecture
platform-modules
platforms
lookup-platform-by-system
lookup-platform-by-target
lookup-platform-by-target-or-system
platform-system->target
platform-target->system
systems
targets))
;;;
;;; Platform record.
;;;
;; Description of a platform supported by the GNU system.
;; Description of a platform supported by GNU Guix.
;;
;; The 'target' field must be a valid GNU triplet as defined here:
;; https://www.gnu.org/software/autoconf/manual/autoconf-2.68/html_node/Specifying-Target-Triplets.html.
;; It is used for cross-compilation purposes.
;;
;; The 'system' field is the name of the corresponding system as defined in
;; the (gnu packages bootstrap) module. It can be for instance
;; "aarch64-linux" or "armhf-linux". It is used to emulate a different host
;; architecture, for instance i686-linux on x86_64-linux-gnu, or armhf-linux
;; on x86_64-linux, using the QEMU binfmt transparent emulation mechanism.
;;
;; The 'linux-architecture' is only relevant if the kernel is Linux. In that
;; case, it corresponds to the ARCH variable used when building Linux.
(define-record-type* <platform> platform make-platform
platform?
(target platform-target) ;"x86_64-linux-gnu"
(system platform-system) ;"x86_64-linux"
(linux-architecture platform-linux-architecture ;"amd64"
(linux-architecture platform-linux-architecture ;"x86"
(default #f)))
;;;
;;; Platforms.
;;;
(define (platform-modules)
"Return the list of platform modules."
(all-modules (map (lambda (entry)
`(,entry . "gnu/platforms"))
%load-path)
#:warn warn-about-load-error))
(define platforms
;; The list of publically-known platforms.
(memoize
(lambda ()
(fold-module-public-variables (lambda (obj result)
(if (platform? obj)
(cons obj result)
result))
'()
(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)))
(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)))
(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)))
(define (platform-system->target system)
"Return the target matching the given SYSTEM if it exists or false
otherwise."
(let ((platform (lookup-platform-by-system system)))
(and=> platform platform-target)))
(define (platform-target->system target)
"Return the system matching the given TARGET if it exists or false
otherwise."
(let ((platform (lookup-platform-by-target system)))
(and=> platform platform-system)))
;;;
;;; Systems & Targets.
;;;
(define (systems)
"Return the list of supported systems."
(delete-duplicates
(filter-map platform-system (platforms))))
(define (targets)
"Return the list of supported targets."
(map platform-target (platforms)))