summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2012-09-01 19:21:06 +0200
committerLudovic Courtès <ludo@gnu.org>2012-09-01 19:21:31 +0200
commit8197c978efb3fff61db42e80dd7358e7ee15bf20 (patch)
treee3fb53962dc1cf64d4fd2243474e04b8c6505e4a
parent9dd036f35c9a825c30aecc9eb3a3f6266481cfe3 (diff)
downloadguix-8197c978efb3fff61db42e80dd7358e7ee15bf20.tar.gz
utils: Change `substitute*' to allow iteration over several matches.
* guix/build/utils.scm (substitute): Do not pass the OUT to PROC; use
  `list-matches' instead of `regexp-exec' and pass a list of matches to
  PROC. Expect PROC to return a string, and output that.  Fold over
  RX+PROC in order.  Use `(read-line p 'concat)' to include the trailing
  delimiter in LINE.
  (substitute*): Produce code to iterate over the matches, and return a
  string, which includes anything from the original line that's in
  between matches.

* distro/base.scm (gcc-4.7, glibc): Adjust accordingly: remove use
  of (ice-9 regex) and `regexp-substitute/global'; return a string.
-rw-r--r--distro/base.scm25
-rw-r--r--guix/build/utils.scm51
2 files changed, 39 insertions, 37 deletions
diff --git a/distro/base.scm b/distro/base.scm
index c3a6846581..7ff15ad2eb 100644
--- a/distro/base.scm
+++ b/distro/base.scm
@@ -588,10 +588,7 @@ BFD (Binary File Descriptor) library, `gprof', `nm', `strip', etc.")
                ("mpfr" ,mpfr)
                ("mpc" ,mpc)))           ; TODO: libelf, ppl, cloog, zlib, etc.
      (arguments
-      `(#:modules ((guix build utils)
-                   (guix build gnu-build-system)
-                   (ice-9 regex))                 ; we need this one
-        #:out-of-source? #t
+      `(#:out-of-source? #t
         #:strip-binaries? ,stripped?
         #:configure-flags
         `("--enable-plugin"
@@ -639,12 +636,8 @@ BFD (Binary File Descriptor) library, `gprof', `nm', `strip', etc.")
                (("#define LIB_SPEC (.*)$" _ suffix)
                 (format #f "#define LIB_SPEC \"-L~a/lib -rpath=~a/lib64 -rpath=~a/lib \" ~a~%"
                         libc out out suffix))
-               (("^.*crt([^\\.])\\.o.*$" line)
-                (regexp-substitute/global #f
-                                          "([a-zA-Z]?)crt([^\\.])\\.o"
-                                          (string-append line "\n")
-                                          'pre libc "/lib/" 1 "crt" 2 ".o"
-                                          'post)))))
+               (("([^ ]*)crt([^\\.])\\.o" _ prefix suffix)
+                (string-append libc "/lib/" prefix "crt" suffix ".o")))))
          (alist-cons-after
           'configure 'post-configure
           (lambda _
@@ -1121,10 +1114,7 @@ call interface, and powerful string processing.")
    (build-system gnu-build-system)
    (native-inputs `(("linux-headers" ,linux-headers)))
    (arguments
-    `(#:modules ((guix build utils)
-                 (guix build gnu-build-system)
-                 (ice-9 regex))
-      #:out-of-source? #t
+    `(#:out-of-source? #t
       #:configure-flags
       (list "--enable-add-ons"
             "--sysconfdir=/etc"
@@ -1145,13 +1135,10 @@ call interface, and powerful string processing.")
                   (let ((out (assoc-ref outputs "out")))
                     ;; Use `pwd', not `/bin/pwd'.
                     (substitute* "configure"
-                      (("^.*/bin/pwd.*$" line)
-                       (regexp-substitute/global #f
-                                                 "/bin/pwd"
-                                                 (string-append line "\n")
-                                                 'pre "pwd" 'post)))
+                      (("/bin/pwd" _) "pwd"))
 
                     ;; Install the rpc data base file under `$out/etc/rpc'.
+                    ;; FIXME: Use installFlags = [ "sysconfdir=$(out)/etc" ];
                     (substitute* "sunrpc/Makefile"
                       (("^\\$\\(inst_sysconfdir\\)/rpc(.*)$" _ suffix)
                        (string-append out "/etc/rpc" suffix "\n"))
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 13ea4b82d8..6005813f77 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -159,7 +159,8 @@ An error is raised when no such pair exists."
 (define (substitute file pattern+procs)
   "PATTERN+PROCS is a list of regexp/two-argument procedure.  For each line
 of FILE, and for each PATTERN that it matches, call the corresponding PROC
-as (PROC MATCH OUTPUT-PORT)."
+as (PROC LINE MATCHES); PROC must return the line that will be written as a
+substitution of the original line."
   (let* ((rx+proc  (map (match-lambda
                          (((? regexp? pattern) . proc)
                           (cons pattern proc))
@@ -174,22 +175,20 @@ as (PROC MATCH OUTPUT-PORT)."
       (lambda ()
         (call-with-input-file file
           (lambda (in)
-            (let loop ((line (read-line in)))
+            (let loop ((line (read-line in 'concat)))
               (if (eof-object? line)
                   #t
-                  (begin
-                    (or (any (match-lambda
-                              ((regexp . proc)
-                               (and=> (regexp-exec regexp line)
-                                      (lambda (m)
-                                        (proc m out)
-                                        #t))))
-                             rx+proc)
-                        (begin
-                          (display line out)
-                          (newline out)
-                          #t))
-                    (loop (read-line in)))))))
+                  (let ((line (fold (lambda (r+p line)
+                                      (match r+p
+                                        ((regexp . proc)
+                                         (match (list-matches regexp line)
+                                           ((and m+ (_ _ ...))
+                                            (proc line m+))
+                                           (_ line)))))
+                                    line
+                                    rx+proc)))
+                    (display line out)
+                    (loop (read-line in 'concat)))))))
         (close out)
         (chmod template mode)
         (rename-file template file))
@@ -236,9 +235,24 @@ match substring."
     ((substitute* file ((regexp match-var ...) body ...) ...)
      (substitute file
                  (list (cons regexp
-                             (lambda (m p)
-                               (let-matches 0 m (match-var ...)
-                                            (display (begin body ...) p))))
+                             (lambda (l m+)
+                               ;; Iterate over matches M+ and return the
+                               ;; modified line based on L.
+                               (let loop ((m* m+)   ; matches
+                                          (o  0)    ; offset in L
+                                          (r  '())) ; result
+                                 (match m*
+                                   (()
+                                    (let ((r (cons (substring l o) r)))
+                                      (string-concatenate-reverse r)))
+                                   ((m . rest)
+                                    (let-matches 0 m (match-var ...)
+                                      (loop rest
+                                            (match:end m)
+                                            (cons*
+                                             (begin body ...)
+                                             (substring l o (match:start m))
+                                             r))))))))
                        ...)))))
 
 
@@ -313,4 +327,5 @@ patched, #f otherwise."
 ;;; Local Variables:
 ;;; eval: (put 'call-with-output-file/atomic 'scheme-indent-function 1)
 ;;; eval: (put 'with-throw-handler 'scheme-indent-function 1)
+;;; eval: (put 'let-matches 'scheme-indent-function 3)
 ;;; End: