From bfeccc6ba4f9f3460ac9f58235e25ebde80e60e1 Mon Sep 17 00:00:00 2001 From: Rutherther Date: Sun, 6 Jul 2025 12:34:01 +0800 Subject: [PATCH] feat: Add cross profile package support Supports cross profile with the default target packages from gnu-build-system. Accepts inputs, native-inputs or inputs-from where the inputs are taken out of the package. What remains is to think of a way to support arbitrary build system, possibly via bags. As a first proof of concept, the build system could be matched and packages hardcoded for each of them... then the inputs can be taken when inputs-from is used, or one could make a list of build systems to include in a new field. --- modules/cross-shells/cross-profile.scm | 176 +++++++++++++++++++++++++ 1 file changed, 176 insertions(+) create mode 100644 modules/cross-shells/cross-profile.scm diff --git a/modules/cross-shells/cross-profile.scm b/modules/cross-shells/cross-profile.scm new file mode 100644 index 0000000000000000000000000000000000000000..be9a57bfa635ca360d207d1001ae8492856bc2e2 --- /dev/null +++ b/modules/cross-shells/cross-profile.scm @@ -0,0 +1,176 @@ +(define-module (cross-shells cross-profile) + #:use-module (srfi srfi-1) + #:use-module (cross-shells cross-packages) + #:use-module (guix gexp) + #:use-module (guix packages) + #:use-module (guix records) + #:use-module (guix search-paths) + #:use-module (gnu packages commencement) + #:use-module (guix build-system gnu) + #:use-module (guix build-system trivial) + #:export (make-cross-profile + cross-profile + cross-profile? + cross-profile-name + cross-profile-host-system + cross-profile-target-system + cross-profile-native-inputs + cross-profile-inputs + cross-profile-inputs-from + + %cross-profile-default-base-native-inputs + %cross-profile-default-base-inputs + + make-cross-profile-package + collect-cross-profile-native-inputs + collect-cross-profile-target-inputs + collect-cross-profile-search-paths)) + +;; TODO: allow procedure in native-inputs and inputs +;; takes system and target + +(define (%cross-profile-default-base-native-inputs system target) + (append + (standard-packages system) + (standard-cross-packages target 'host))) + +(define (%cross-profile-default-base-inputs system target) + (list)) + +(define (%cross-profile-default-base-target-inputs system target) + (standard-cross-packages target 'target)) + +(define-record-type* cross-profile make-cross-profile + cross-profile? + (name cross-profile-name (default "default")) + (host-system cross-profile-host-system (default (%current-system))) + (target-system cross-profile-target-system) + ;; The default native inputs and inputs. Those are + ;; taken out of the gnu-build-system. + (base-native-inputs cross-profile-base-native-inputs (default %cross-profile-default-base-native-inputs)) + (base-target-inputs cross-profile-base-target-inputs (default %cross-profile-default-base-target-inputs)) + (base-inputs cross-profile-base-inputs (default %cross-profile-default-base-inputs)) + ;; The inputs that are runnable on the host system + (native-inputs cross-profile-native-inputs (default '())) + ;; The packages to get for the target system, like libraries. + (inputs cross-profile-inputs (default '())) + ;; The packages to get for the target system, like libraries. + (target-inputs cross-profile-target-inputs (default '())) + ;; Take inputs/native-inputs from the given packages. + (inputs-from cross-profile-inputs-from (default '()))) + +(define transitive-inputs + (@@ (guix packages) transitive-inputs)) + +(define (collect-cross-profile-target-inputs cross-profile) + ;; Get all inputs (merged inputs and inputs-from inputs) + ;; Also collect propagated inputs. Make sure only unique packages. + ;; NOTE look how profiles work + (match-record + cross-profile + (target-inputs base-target-inputs host-system target-system) + (map (lambda (input) + (car (cdr input))) + (transitive-inputs + (append + (base-target-inputs host-system target-system) + target-inputs))))) + +(define (collect-cross-profile-inputs cross-profile) + ;; Get all inputs (merged inputs and inputs-from inputs) + ;; Also collect propagated inputs. Make sure only unique packages. + ;; NOTE look how profiles work + (match-record + cross-profile + (inputs inputs-from base-inputs host-system target-system) + (map (lambda (input) + (if (package? input) + input + (car (cdr input)))) + (transitive-inputs + (append + (base-inputs host-system target-system) + (apply append (map package-inputs inputs-from)) + inputs))))) + +(define (collect-cross-profile-native-inputs cross-profile) + ;; Get all nativeinputs (merged native-inputs and inputs-from native-inputs) + (match-record + cross-profile + (native-inputs inputs-from base-native-inputs host-system target-system) + (map (lambda (input) + (car (cdr input))) + (transitive-inputs + (append + (base-native-inputs host-system target-system) + (apply append (map package-native-inputs inputs-from)) + native-inputs))))) + +(define (collect-cross-profile-search-paths cross-profile) + (match-record + cross-profile + (name target-system) + (apply append + (append + (append (map package-native-search-paths + (collect-cross-profile-native-inputs cross-profile))) + (append (map (lambda (package) + (map + (lambda (search-path) + (search-path-specification + (inherit search-path) + (files (map + (lambda (file) + (string-append "cross/" target-system "/" name "/" file)) + (search-path-specification-files search-path))))) + (package-search-paths package))) + (append + (collect-cross-profile-target-inputs cross-profile) + (collect-cross-profile-inputs cross-profile)))))))) + + +;; output is a package. +;; but this package is sort of like a profile. +;; it will have all files under cross/{target}. +;; it will put all accumulated search-paths to native-search-paths +;; Takes a cross-profile, and outputs a package that represents the cross profile +(define (make-cross-profile-package cross-profile) + (match-record + cross-profile + (name host-system target-system native-inputs inputs inputs-from) + (let ((cross-profile-name name)) + (package + (name (string-append "cross-profile-" name)) + (source #f) + (version "0") + (build-system trivial-build-system) + (native-search-paths ;; collect search paths of all inputs + (collect-cross-profile-search-paths cross-profile)) + (arguments + (list + #:modules '((guix build utils) + (guix build union)) + #:builder #~(begin + (use-modules + (guix build utils) + (guix build union)) + (let ((inputs-paths + (list #$@(collect-cross-profile-target-inputs cross-profile) + #$@(map (lambda (package) + (cross-package-job + (package package) + (target target-system) + (system host-system))) + (collect-cross-profile-inputs cross-profile)))) + (cross-profile-path + (string-append #$output "/cross/" #$target-system "/" #$cross-profile-name)) + (native-inputs-paths + (list #$@(collect-cross-profile-native-inputs cross-profile)))) + + (union-build #$output native-inputs-paths) + (mkdir-p (dirname cross-profile-path)) + (union-build cross-profile-path inputs-paths))))) + (synopsis "A cross profile package") + (description "A cross profile package") + (home-page #f) + (license #f)))))