futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

utils: Change `substitute*' to allow iteration over several matches.

Browse Source 
* 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.
This commit is contained in:
Ludovic Courtès 2012-09-01 19:21:06 +02:00
parent 9dd036f35c
commit 8197c978ef
2 changed files with 39 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
distro/base.scm
View File

@ -588,10 +588,7 @@ BFD (Binary File Descriptor) library, `gprof', `nm', `strip', etc.")
("mpfr" ,mpfr) ("mpfr" ,mpfr)
("mpc" ,mpc))) ; TODO: libelf, ppl, cloog, zlib, etc. ("mpc" ,mpc))) ; TODO: libelf, ppl, cloog, zlib, etc.
(arguments (arguments
`(#:modules ((guix build utils) `(#:out-of-source? #t
(guix build gnu-build-system)
(ice-9 regex)) ; we need this one
#:out-of-source? #t
#:strip-binaries? ,stripped? #:strip-binaries? ,stripped?
#:configure-flags #:configure-flags
`("--enable-plugin" `("--enable-plugin"
@ -639,12 +636,8 @@ BFD (Binary File Descriptor) library, `gprof', `nm', `strip', etc.")
(("#define LIB_SPEC (.*)$" _ suffix) (("#define LIB_SPEC (.*)$" _ suffix)
(format #f "#define LIB_SPEC \"-L~a/lib -rpath=~a/lib64 -rpath=~a/lib \" ~a~%" (format #f "#define LIB_SPEC \"-L~a/lib -rpath=~a/lib64 -rpath=~a/lib \" ~a~%"
libc out out suffix)) libc out out suffix))
(("^.*crt([^\\.])\\.o.*$" line) (("([^ ]*)crt([^\\.])\\.o" _ prefix suffix)
(regexp-substitute/global #f (string-append libc "/lib/" prefix "crt" suffix ".o")))))
"([a-zA-Z]?)crt([^\\.])\\.o"
(string-append line "\n")
'pre libc "/lib/" 1 "crt" 2 ".o"
'post)))))
(alist-cons-after (alist-cons-after
'configure 'post-configure 'configure 'post-configure
(lambda _ (lambda _
@ -1121,10 +1114,7 @@ call interface, and powerful string processing.")
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs `(("linux-headers" ,linux-headers))) (native-inputs `(("linux-headers" ,linux-headers)))
(arguments (arguments
`(#:modules ((guix build utils) `(#:out-of-source? #t
(guix build gnu-build-system)
(ice-9 regex))
#:out-of-source? #t
#:configure-flags #:configure-flags
(list "--enable-add-ons" (list "--enable-add-ons"
"--sysconfdir=/etc" "--sysconfdir=/etc"
@ -1145,13 +1135,10 @@ call interface, and powerful string processing.")
(let ((out (assoc-ref outputs "out"))) (let ((out (assoc-ref outputs "out")))
;; Use `pwd', not `/bin/pwd'. ;; Use `pwd', not `/bin/pwd'.
(substitute* "configure" (substitute* "configure"
(("^.*/bin/pwd.*$" line) (("/bin/pwd" _) "pwd"))
(regexp-substitute/global #f
"/bin/pwd"
(string-append line "\n")
'pre "pwd" 'post)))
;; Install the rpc data base file under `$out/etc/rpc'. ;; Install the rpc data base file under `$out/etc/rpc'.
;; FIXME: Use installFlags = [ "sysconfdir=$(out)/etc" ];
(substitute* "sunrpc/Makefile" (substitute* "sunrpc/Makefile"
(("^\\$\\(inst_sysconfdir\\)/rpc(.*)$" _ suffix) (("^\\$\\(inst_sysconfdir\\)/rpc(.*)$" _ suffix)
(string-append out "/etc/rpc" suffix "\n")) (string-append out "/etc/rpc" suffix "\n"))

51
guix/build/utils.scm
View File

@ -159,7 +159,8 @@ An error is raised when no such pair exists."
(define (substitute file pattern+procs) (define (substitute file pattern+procs)
"PATTERN+PROCS is a list of regexp/two-argument procedure. For each line "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 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 (let* ((rx+proc (map (match-lambda
(((? regexp? pattern) . proc) (((? regexp? pattern) . proc)
(cons pattern proc)) (cons pattern proc))
@ -174,22 +175,20 @@ as (PROC MATCH OUTPUT-PORT)."
(lambda () (lambda ()
(call-with-input-file file (call-with-input-file file
(lambda (in) (lambda (in)
(let loop ((line (read-line in))) (let loop ((line (read-line in 'concat)))
(if (eof-object? line) (if (eof-object? line)
#t #t
(begin (let ((line (fold (lambda (r+p line)
(or (any (match-lambda (match r+p
((regexp . proc) ((regexp . proc)
(and=> (regexp-exec regexp line) (match (list-matches regexp line)
(lambda (m) ((and m+ (_ _ ...))
(proc m out) (proc line m+))
#t)))) (_ line)))))
rx+proc) line
(begin rx+proc)))
(display line out) (display line out)
(newline out) (loop (read-line in 'concat)))))))
#t))
(loop (read-line in)))))))
(close out) (close out)
(chmod template mode) (chmod template mode)
(rename-file template file)) (rename-file template file))
@ -236,9 +235,24 @@ match substring."
((substitute* file ((regexp match-var ...) body ...) ...) ((substitute* file ((regexp match-var ...) body ...) ...)
(substitute file (substitute file
(list (cons regexp (list (cons regexp
(lambda (m p) (lambda (l m+)
(let-matches 0 m (match-var ...) ;; Iterate over matches M+ and return the
(display (begin body ...) p)))) ;; 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: ;;; Local Variables:
;;; eval: (put 'call-with-output-file/atomic 'scheme-indent-function 1) ;;; eval: (put 'call-with-output-file/atomic 'scheme-indent-function 1)
;;; eval: (put 'with-throw-handler 'scheme-indent-function 1) ;;; eval: (put 'with-throw-handler 'scheme-indent-function 1)
;;; eval: (put 'let-matches 'scheme-indent-function 3)
;;; End: ;;; End: