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: