From 8ddc41e1f25b643beaa204b1f5c271cfe7f3e0a9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 26 Feb 2015 22:48:14 +0100 Subject: utils: Add 'modify-phases'. * guix/build/utils.scm (modify-phases): New macro. --- guix/build/utils.scm | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) (limited to 'guix/build/utils.scm') 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 ) + (replace ) + (add-before ) + (add-after ) + +Where every <*-phase-name> is an automatically quoted symbol, and +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). -- cgit v1.2.3