~ruther/guix-local

8ddc41e1f25b643beaa204b1f5c271cfe7f3e0a9 — Ludovic Courtès 11 years ago cd0385b
utils: Add 'modify-phases'.

* guix/build/utils.scm (modify-phases): New macro.
2 files changed, 29 insertions(+), 0 deletions(-)

M .dir-locals.el
M guix/build/utils.scm
M .dir-locals.el => .dir-locals.el +1 -0
@@ 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))

M guix/build/utils.scm => guix/build/utils.scm +28 -0
@@ 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).