utils: Add 'modify-phases'.

* guix/build/utils.scm (modify-phases): New macro.
This commit is contained in:
Ludovic Courtès 2015-02-26 22:48:14 +01:00
parent cd0385b61a
commit 8ddc41e1f2
2 changed files with 29 additions and 0 deletions

View File

@ -20,6 +20,7 @@
(eval . (put 'guard 'scheme-indent-function 1)) (eval . (put 'guard 'scheme-indent-function 1))
(eval . (put 'lambda* 'scheme-indent-function 1)) (eval . (put 'lambda* 'scheme-indent-function 1))
(eval . (put 'substitute* 'scheme-indent-function 1)) (eval . (put 'substitute* 'scheme-indent-function 1))
(eval . (put 'modify-phases 'scheme-indent-function 1))
(eval . (put 'with-directory-excursion 'scheme-indent-function 1)) (eval . (put 'with-directory-excursion 'scheme-indent-function 1))
(eval . (put 'package 'scheme-indent-function 0)) (eval . (put 'package 'scheme-indent-function 0))
(eval . (put 'origin 'scheme-indent-function 0)) (eval . (put 'origin 'scheme-indent-function 0))

View File

@ -54,6 +54,7 @@
alist-cons-before alist-cons-before
alist-cons-after alist-cons-after
alist-replace alist-replace
modify-phases
with-atomic-file-replacement with-atomic-file-replacement
substitute substitute
substitute* substitute*
@ -423,6 +424,33 @@ An error is raised when no such pair exists."
((_ after ...) ((_ after ...)
(append before (alist-cons key value after)))))) (append before (alist-cons key value after))))))
(define-syntax-rule (modify-phases phases mod-spec ...)
"Modify PHASES sequentially as per each MOD-SPEC, which may have one of the
following forms:
(delete <old-phase-name>)
(replace <old-phase-name> <new-phase>)
(add-before <old-phase-name> <new-phase-name> <new-phase>)
(add-after <old-phase-name> <new-phase-name> <new-phase>)
Where every <*-phase-name> is an automatically quoted symbol, and <new-phase>
an expression evaluating to a procedure."
(let* ((phases* phases)
(phases* (%modify-phases phases* mod-spec))
...)
phases*))
(define-syntax %modify-phases
(syntax-rules (delete replace add-before add-after)
((_ phases (delete old-phase-name))
(alist-delete 'old-phase-name phases))
((_ phases (replace old-phase-name new-phase))
(alist-replace 'old-phase-name new-phase phases))
((_ phases (add-before old-phase-name new-phase-name new-phase))
(alist-cons-before 'old-phase-name 'new-phase-name new-phase phases))
((_ phases (add-after old-phase-name new-phase-name new-phase))
(alist-cons-after 'old-phase-name 'new-phase-name new-phase phases))))
;;; ;;;
;;; Text substitution (aka. sed). ;;; Text substitution (aka. sed).