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

diff --git a/distro/base.scm b/distro/base.scm
index b11a7f2116..7bcac56730 100644
--- a/distro/base.scm
+++ b/distro/base.scm
@@ -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"))
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 1808c63ce5..19728e6015 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -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)