1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
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> 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 <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 <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 <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 <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 <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)))))