mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
platform: Add discovery support.
* 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:
parent
31f7696be4
commit
4f2320f79d
1 changed files with 98 additions and 3 deletions
101
gnu/platform.scm
101
gnu/platform.scm
|
@ -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)))
|
||||
|
|
Loading…
Reference in a new issue