diff options
author | Ludovic Courtès <ludo@gnu.org> | 2015-02-26 22:48:14 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2015-02-26 22:48:39 +0100 |
commit | 8ddc41e1f25b643beaa204b1f5c271cfe7f3e0a9 (patch) | |
tree | 51012af80e2f7ca14cbfe720a6be6b918da547cc | |
parent | cd0385b61a934eafe1601e7c22024cf452d357c2 (diff) | |
download | patches-8ddc41e1f25b643beaa204b1f5c271cfe7f3e0a9.tar patches-8ddc41e1f25b643beaa204b1f5c271cfe7f3e0a9.tar.gz |
utils: Add 'modify-phases'.
* guix/build/utils.scm (modify-phases): New macro.
-rw-r--r-- | .dir-locals.el | 1 | ||||
-rw-r--r-- | guix/build/utils.scm | 28 |
2 files changed, 29 insertions, 0 deletions
diff --git a/.dir-locals.el b/.dir-locals.el index e056e26c9a..7aef853625 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -20,6 +20,7 @@ (eval . (put 'guard 'scheme-indent-function 1)) (eval . (put 'lambda* '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 'package 'scheme-indent-function 0)) (eval . (put 'origin 'scheme-indent-function 0)) diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 6de1fa3b1e..f24ed47f3e 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -54,6 +54,7 @@ alist-cons-before alist-cons-after alist-replace + modify-phases with-atomic-file-replacement substitute substitute* @@ -423,6 +424,33 @@ An error is raised when no such pair exists." ((_ 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). |