~ruther/guix-local

10c87717bd70c9d7e47a13753dc2756a97f00e35 — Ludovic Courtès 13 years ago d767288
utils: Introduce `substitute*', for easier sed-like syntax.

* guix/build/utils.scm (let-matches, substitute*): New macros.

* distro/base.scm (guile-1.8): Use `substitute*' instead of
  `substitute'.  Remove the #:modules argument.
2 files changed, 46 insertions(+), 12 deletions(-)

M distro/base.scm
M guix/build/utils.scm
M distro/base.scm => distro/base.scm +7 -11
@@ 120,10 120,7 @@ code.")
             (base32
              "0l200a0v7h8bh0cwz6v7hc13ds39cgqsmfrks55b1rbj5vniyiy3"))))
   (build-system gnu-build-system)
   (arguments '(#:modules ((guix build gnu-build-system)
                           (guix build utils)
                           (ice-9 regex))
                #:configure-flags '("--disable-error-on-warning")
   (arguments '(#:configure-flags '("--disable-error-on-warning")
                #:patches (list (assoc-ref %build-inputs "patch/snarf"))

                ;; Insert a phase before `configure' to patch things up.


@@ 134,13 131,12 @@ code.")
                             ;; Add a call to `lt_dladdsearchdir' so that
                             ;; `libguile-readline.so' & co. are in the
                             ;; loader's search path.
                             (substitute "libguile/dynl.c"
                                         "lt_dlinit.*$"
                                         (lambda (m p)
                                           (format p
                                                   "  ~a~%  //lt_dladdsearchdir(\"~a/lib\");~%"
                                                   (match:substring m 0)
                                                   (assoc-ref outputs "out")))))
                             (substitute* "libguile/dynl.c"
                                          ("lt_dlinit.*$" match)
                                          (format #f
                                                  "  ~a~%  lt_dladdsearchdir(\"~a/lib\");~%"
                                                  match
                                                  (assoc-ref outputs "out"))))
                           %standard-phases)))
   (inputs `(("patch/snarf"
              ,(search-path %load-path "distro/guile-1.8-cpp-4.5.patch"))

M guix/build/utils.scm => guix/build/utils.scm +39 -1
@@ 28,7 28,8 @@
            alist-cons-before
            alist-cons-after
            alist-replace
            substitute))
            substitute
            substitute*))


;;;


@@ 175,6 176,43 @@ MATCH OUTPUT-PORT)."
      (lambda (key . args)
        (false-if-exception (delete-file template))))))


(define-syntax let-matches
  ;; Helper macro for `substitute*'.
  (syntax-rules (_)
    ((let-matches index match (_ vars ...) body ...)
     (let-matches (+ 1 index) match (vars ...)
                  body ...))
    ((let-matches index match (var vars ...) body ...)
     (let ((var (match:substring match index)))
       (let-matches (+ 1 index) match (vars ...)
                    body ...)))
    ((let-matches index match () body ...)
     (begin body ...))))

(define-syntax-rule (substitute* file (regexp whole-match match ...)
                                 body ...)
  "Substitute REGEXP in FILE by the string returned by BODY.  BODY is
evaluated with each MATCH-VAR bound to the corresponding positional regexp
sub-expression.  For example:

  (substitute* file (\"foo([a-z]+)bar(.*)$\" all letters end)
    (string-append \"baz\" letters end))

Here, anytime a line of FILE matches the regexp, ALL is bound to the complete
match, LETTERS is bound to the first sub-expression, and END is bound to the
last one.  Alternatively, given that `all' is not used, one can write:

  (substitute* file (\"foo([a-z]+)bar(.*)$\" _ letters end)
    (string-append \"baz\" letter end))

"
  (substitute file regexp
              (lambda (m p)
                (let-matches 0 m (whole-match match ...)
                             (display (begin body ...) p)))))


;;; Local Variables:
;;; eval: (put 'call-with-output-file/atomic 'scheme-indent-function 1)
;;; eval: (put 'with-throw-handler 'scheme-indent-function 1)