mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-18 04:37:36 -05:00
vm: Use 'let-system'.
* gnu/system/vm.scm (expression->derivation-in-linux-vm)[check]: New macro. [builder]: Use 'let-system' and 'check' instead of referencing '%current-system' and '%current-target-system'.
This commit is contained in:
parent
3d028f03c8
commit
ba3138ab0f
1 changed files with 8 additions and 7 deletions
|
@ -199,6 +199,10 @@ (define loader
|
||||||
(sync)
|
(sync)
|
||||||
(reboot))))
|
(reboot))))
|
||||||
|
|
||||||
|
(define-syntax-rule (check predicate)
|
||||||
|
(let-system (system target)
|
||||||
|
(predicate (or target system))))
|
||||||
|
|
||||||
(let ((initrd (or initrd
|
(let ((initrd (or initrd
|
||||||
(base-initrd file-systems
|
(base-initrd file-systems
|
||||||
#:on-error 'backtrace
|
#:on-error 'backtrace
|
||||||
|
@ -229,7 +233,8 @@ (define builder
|
||||||
(graphs '#$(match references-graphs
|
(graphs '#$(match references-graphs
|
||||||
(((graph-files . _) ...) graph-files)
|
(((graph-files . _) ...) graph-files)
|
||||||
(_ #f)))
|
(_ #f)))
|
||||||
(target #$(or (%current-target-system) (%current-system)))
|
(target #$(let-system (system target)
|
||||||
|
(or target system)))
|
||||||
(size #$(if (eq? 'guess disk-image-size)
|
(size #$(if (eq? 'guess disk-image-size)
|
||||||
#~(+ (* 70 (expt 2 20)) ;ESP
|
#~(+ (* 70 (expt 2 20)) ;ESP
|
||||||
(estimated-partition-size graphs))
|
(estimated-partition-size graphs))
|
||||||
|
@ -244,12 +249,8 @@ (define builder
|
||||||
#:memory-size #$memory-size
|
#:memory-size #$memory-size
|
||||||
#:make-disk-image? #$make-disk-image?
|
#:make-disk-image? #$make-disk-image?
|
||||||
#:single-file-output? #$single-file-output?
|
#:single-file-output? #$single-file-output?
|
||||||
;; FIXME: ‘target-arm32?’ and
|
#:target-arm32? #$(check target-arm32?)
|
||||||
;; ‘target-aarch64?’ may not operate on the
|
#:target-aarch64? #$(check target-aarch64?)
|
||||||
;; right system/target values. Rewrite
|
|
||||||
;; using ‘let-system’ when available.
|
|
||||||
#:target-arm32? #$(target-arm32?)
|
|
||||||
#:target-aarch64? #$(target-aarch64?)
|
|
||||||
#:disk-image-format #$disk-image-format
|
#:disk-image-format #$disk-image-format
|
||||||
#:disk-image-size size
|
#:disk-image-size size
|
||||||
#:references-graphs graphs))))))
|
#:references-graphs graphs))))))
|
||||||
|
|
Loading…
Reference in a new issue