mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
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.
This commit is contained in:
parent
7172116ca5
commit
7da95264f1
3 changed files with 34 additions and 17 deletions
|
@ -1481,8 +1481,7 @@ (define gnu-make-boot0
|
|||
'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 @@ (define gcc-boot0-wrapped
|
|||
(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 @@ (define ld-wrapper-boot3
|
|||
(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 @@ (define (copy-directory source destination)
|
|||
|
||||
(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 @@ (define (copy-recursively source destination)
|
|||
|
||||
(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"))
|
||||
|
||||
|
|
|
@ -46,12 +46,10 @@ (define-public lout
|
|||
(("^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,6 +26,7 @@ (define-module (guix build utils)
|
|||
#: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 @@ (define-syntax-rule (with-directory-excursion dir body ...)
|
|||
(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.
|
||||
|
|
Loading…
Reference in a new issue