utils: Add `default-keyword-arguments' and `substitute-keyword-arguments'.

* distro/packages/base.scm (default-keyword-arguments,
  substitute-keyword-arguments): Move to...
* guix/utils.scm: ... here.
This commit is contained in:
Ludovic Courtès 2012-11-05 23:46:55 +01:00
parent a48dddfe9c
commit 0af2c24ef7
2 changed files with 33 additions and 31 deletions

View File

@ -564,37 +564,6 @@ with the Linux kernel.")
;;; Bootstrap packages.
;;;
(define (default-keyword-arguments args defaults)
"Return ARGS augmented with any keyword/value from DEFAULTS for
keywords not already present in ARGS."
(let loop ((defaults defaults)
(args args))
(match defaults
((kw value rest ...)
(loop rest
(if (assoc-ref kw args)
args
(cons* kw value args))))
(()
args))))
(define-syntax substitute-keyword-arguments
(syntax-rules ()
"Return a new list of arguments where the value for keyword arg KW is
replaced by EXP. EXP is evaluated in a context where VAR is boud to the
previous value of the keyword argument."
((_ original-args ((kw var) exp) ...)
(let loop ((args original-args)
(before '()))
(match args
((kw var rest (... ...))
(loop rest (cons* exp kw before)))
...
((x rest (... ...))
(loop rest (cons x before)))
(()
(reverse before)))))))
(define gnu-make-boot0
(package-with-bootstrap-guile
(package (inherit gnu-make)

View File

@ -49,6 +49,8 @@
define-record-type*
compile-time-value
memoize
default-keyword-arguments
substitute-keyword-arguments
location
location?
@ -546,6 +548,37 @@ FIELD/DEFAULT-VALUE tuples."
(hash-set! cache args results)
(apply values results)))))))
(define (default-keyword-arguments args defaults)
"Return ARGS augmented with any keyword/value from DEFAULTS for
keywords not already present in ARGS."
(let loop ((defaults defaults)
(args args))
(match defaults
((kw value rest ...)
(loop rest
(if (assoc-ref kw args)
args
(cons* kw value args))))
(()
args))))
(define-syntax substitute-keyword-arguments
(syntax-rules ()
"Return a new list of arguments where the value for keyword arg KW is
replaced by EXP. EXP is evaluated in a context where VAR is boud to the
previous value of the keyword argument."
((_ original-args ((kw var) exp) ...)
(let loop ((args original-args)
(before '()))
(match args
((kw var rest (... ...))
(loop rest (cons* exp kw before)))
...
((x rest (... ...))
(loop rest (cons x before)))
(()
(reverse before)))))))
(define (gnu-triplet->nix-system triplet)
"Return the Nix system type corresponding to TRIPLET, a GNU triplet as
returned by `config.guess'."