me
/
guix
Archived
1
0
Fork 0
Code

utils: Add `mkdir-p'; use it. 

* guix/build/utils.scm (mkdir-p): New procedure.

* distro/packages/base.scm (gnu-make-boot0, gcc-boot0-wrapped,
  ld-wrapper-boot3, %static-binaries, %guile-static-stripped): Use it.
* distro/packages/typesetting.scm (lout): Likewise.
master
Ludovic Courtès 2012-10-17 22:51:08 +02:00
parent 7172116ca5
commit 7da95264f1
3 changed files with 34 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
distro/packages/base.scm
View File

@ -1481,8 +1481,7 @@ previous value of the keyword argument."
'install (lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin")))
(mkdir out)
(mkdir bin)
(mkdir-p bin)
(copy-file "make"
(string-append bin "/make"))))
%standard-phases))))
@ -1709,7 +1708,7 @@ identifier SYSTEM."
(out (assoc-ref %outputs "out"))
(bindir (string-append out "/bin"))
(triplet ,(boot-triplet system)))
(mkdir out) (mkdir bindir)
(mkdir-p bindir)
(with-directory-excursion bindir
(for-each (lambda (tool)
(symlink (string-append binutils "/bin/"
@ -1807,7 +1806,7 @@ exec ~a/bin/~a-gcc -B~a/lib -Wl,-dynamic-linker -Wl,~a/lib/~a \"$@\"~%"
(assoc-ref %build-inputs "binutils")
out)
(mkdir out) (mkdir bin)
(mkdir-p bin)
(copy-file (assoc-ref %build-inputs "wrapper") ld)
(substitute* ld
(("@GUILE@")
@ -2020,7 +2019,7 @@ store.")
(let* ((out (assoc-ref %outputs "out"))
(bin (string-append out "/bin")))
(mkdir out) (mkdir bin)
(mkdir-p bin)
;; Copy Coreutils binaries.
(let* ((coreutils (assoc-ref %build-inputs "coreutils"))
@ -2127,17 +2126,11 @@ store.")
(let ((in (assoc-ref %build-inputs "guile"))
(out (assoc-ref %outputs "out")))
(mkdir out)
(mkdir (string-append out "/share"))
(mkdir (string-append out "/share/guile"))
(mkdir (string-append out "/share/guile/2.0"))
(mkdir-p (string-append out "/share/guile/2.0"))
(copy-recursively (string-append in "/share/guile/2.0")
(string-append out "/share/guile/2.0"))
(mkdir (string-append out "/lib"))
(mkdir (string-append out "/lib/guile"))
(mkdir (string-append out "/lib/guile/2.0"))
(mkdir (string-append out "/lib/guile/2.0/ccache"))
(mkdir-p (string-append out "/lib/guile/2.0/ccache"))
(copy-recursively (string-append in "/lib/guile/2.0/ccache")
(string-append out "/lib/guile/2.0/ccache"))

6
distro/packages/typesetting.scm
View File

@ -46,12 +46,10 @@
(("^MANDIR[[:blank:]]*=.*$")
(string-append "MANDIR = " out "/man\n")))
(mkdir out)
(mkdir (string-append out "/bin")) ; TODO: use `mkdir-p'
(mkdir (string-append out "/bin"))
(mkdir (string-append out "/lib"))
(mkdir (string-append out "/man"))
(mkdir doc)
(mkdir (string-append doc "/doc"))
(mkdir (string-append doc "/doc/lout")))))
(mkdir-p (string-append doc "/doc/lout")))))
(install-man-phase
'(lambda* (#:key outputs #:allow-other-keys)
(zero? (system* "make" "installman"))))

26
guix/build/utils.scm
View File

@ -26,6 +26,7 @@
#:use-module (rnrs io ports)
#:export (directory-exists?
with-directory-excursion
mkdir-p
set-path-environment-variable
search-path-as-string->list
list->search-path-as-string
@ -62,6 +63,31 @@
(lambda ()
(chdir init)))))
(define (mkdir-p dir)
"Create directory DIR and all its ancestors."
(define absolute?
(string-prefix? "/" dir))
(define not-slash
(char-set-complement (char-set #\/)))
(let loop ((components (string-tokenize dir not-slash))
(root (if absolute?
""
".")))
(match components
((head tail ...)
(let ((path (string-append root "/" head)))
(catch 'system-error
(lambda ()
(mkdir path)
(loop tail path))
(lambda args
(if (= EEXIST (system-error-errno args))
(loop tail path)
(apply throw args))))))
(() #t))))
;;;
;;; Search paths.