[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
05/07: gnu: docker: Optimize substitution macros.
From: |
guix-commits |
Subject: |
05/07: gnu: docker: Optimize substitution macros. |
Date: |
Sun, 5 May 2019 21:42:40 -0400 (EDT) |
apteryx pushed a commit to branch master
in repository guix.
commit a01d54f3bdc5bd8d11fdc82ac5d14a974f6c5a86
Author: Maxim Cournoyer <address@hidden>
Date: Sat Apr 13 22:00:45 2019 -0400
gnu: docker: Optimize substitution macros.
This change halves the time needed to patch the paths.
* gnu/packages/docker.scm (docker)[phases]{patch-paths}: Allow passing
multiple SOURCE-TEXT, PACKAGE and RELATIVE-PATH tuples so that the rewrite
rules can be generated and processed by a single use of the SUBSTITUTE*
macro. Rename SUBSTITUTE-LOOKPATH to SUBSTITUTE-LOOKPATH* and
substitute-Command to SUBSTITUTE-COMMAND* to denote the change. Adapt the
uses of SUBSTITUTE-LOOKPATH* and SUBSTITUTE-COMMAND*.
---
gnu/packages/docker.scm | 122 ++++++++++++++++++++++++------------------------
1 file changed, 60 insertions(+), 62 deletions(-)
diff --git a/gnu/packages/docker.scm b/gnu/packages/docker.scm
index e8a742b..c1a99c9 100644
--- a/gnu/packages/docker.scm
+++ b/gnu/packages/docker.scm
@@ -366,68 +366,66 @@ built-in registry server of Docker.")
(let ((source-files (filter (lambda (name)
(not (string-contains name "test")))
(find-files "." "\\.go$"))))
- (let-syntax ((substitute-LookPath
- (lambda (x)
- (syntax-case x ()
- ((substitute-LookPath source-text package
- relative-path)
- #`(substitute* source-files
- ((#,(string-append
"\\<exec\\.LookPath\\(\""
- (syntax->datum
- #'source-text)
- "\")"))
- (string-append "\""
- (assoc-ref inputs
package)
- "/" relative-path
- "\", error(nil)")))))))
- (substitute-Command
- (lambda (x)
- (syntax-case x ()
- ((substitute-LookPath source-text package
- relative-path)
- #`(substitute* source-files
- ((#,(string-append
"\\<(re)?exec\\.Command\\(\""
- (syntax->datum
- #'source-text)
- "\"") _ re?)
- (string-append (if re? re? "")
- "exec.Command(\""
- (assoc-ref inputs
package)
- "/" relative-path
- "\""))))))))
- (substitute-LookPath "ps" "procps" "bin/ps")
- (substitute-LookPath "mkfs.xfs" "xfsprogs" "bin/mkfs.xfs")
- (substitute-LookPath "lvmdiskscan" "lvm2" "sbin/lvmdiskscan")
- (substitute-LookPath "pvdisplay" "lvm2" "sbin/pvdisplay")
- (substitute-LookPath "blkid" "util-linux" "sbin/blkid")
- (substitute-LookPath "unpigz" "pigz" "bin/unpigz")
- (substitute-LookPath "iptables" "iptables" "sbin/iptables")
- (substitute-LookPath "iptables-legacy" "iptables"
"sbin/iptables")
- (substitute-LookPath "ip" "iproute2" "sbin/ip")
- (substitute-Command "modprobe" "kmod" "bin/modprobe")
- (substitute-Command "pvcreate" "lvm2" "sbin/pvcreate")
- (substitute-Command "vgcreate" "lvm2" "sbin/vgcreate")
- (substitute-Command "lvcreate" "lvm2" "sbin/lvcreate")
- (substitute-Command "lvconvert" "lvm2" "sbin/lvconvert")
- (substitute-Command "lvchange" "lvm2" "sbin/lvchange")
- (substitute-Command "mkfs.xfs" "xfsprogs" "sbin/mkfs.xfs")
- (substitute-Command "xfs_growfs" "xfsprogs" "sbin/xfs_growfs")
- (substitute-Command "mkfs.ext4" "e2fsprogs" "sbin/mkfs.ext4")
- (substitute-Command "tune2fs" "e2fsprogs" "sbin/tune2fs")
- (substitute-Command "blkid" "util-linux" "sbin/blkid")
- (substitute-Command "resize2fs" "e2fsprogs" "sbin/resize2fs")
- ;; docker-mountfrom ??
- ;; docker
- ;; docker-untar ??
- ;; docker-applyLayer ??
- ;; /usr/bin/uname
- ;; grep
- ;; apparmor_parser
- (substitute-Command "ps" "procps" "bin/ps")
- (substitute-Command "losetup" "util-linux" "sbin/losetup")
- (substitute-Command "uname" "coreutils" "bin/uname")
- (substitute-Command "dbus-launch" "dbus" "bin/dbus-launch")
- (substitute-Command "git" "git" "bin/git"))
+ (let-syntax ((substitute-LookPath*
+ (syntax-rules ()
+ ((_ (source-text package relative-path) ...)
+ (substitute* source-files
+ (((string-append "\\<exec\\.LookPath\\(\""
+ source-text
+ "\")"))
+ (string-append "\""
+ (assoc-ref inputs package)
+ "/" relative-path
+ "\", error(nil)")) ...))))
+ (substitute-Command*
+ (syntax-rules ()
+ ((_ (source-text package relative-path) ...)
+ (substitute* source-files
+ (((string-append
"\\<(re)?exec\\.Command\\(\""
+ source-text
+ "\"") _ re?)
+ (string-append (if re? re? "")
+ "exec.Command(\""
+ (assoc-ref inputs package)
+ "/" relative-path
+ "\"")) ...)))))
+ (substitute-LookPath*
+ ("ps" "procps" "bin/ps")
+ ("mkfs.xfs" "xfsprogs" "bin/mkfs.xfs")
+ ("lvmdiskscan" "lvm2" "sbin/lvmdiskscan")
+ ("pvdisplay" "lvm2" "sbin/pvdisplay")
+ ("blkid" "util-linux" "sbin/blkid")
+ ("unpigz" "pigz" "bin/unpigz")
+ ("iptables" "iptables" "sbin/iptables")
+ ("iptables-legacy" "iptables" "sbin/iptables")
+ ("ip" "iproute2" "sbin/ip"))
+
+ (substitute-Command*
+ ("modprobe" "kmod" "bin/modprobe")
+ ("pvcreate" "lvm2" "sbin/pvcreate")
+ ("vgcreate" "lvm2" "sbin/vgcreate")
+ ("lvcreate" "lvm2" "sbin/lvcreate")
+ ("lvconvert" "lvm2" "sbin/lvconvert")
+ ("lvchange" "lvm2" "sbin/lvchange")
+ ("mkfs.xfs" "xfsprogs" "sbin/mkfs.xfs")
+ ("xfs_growfs" "xfsprogs" "sbin/xfs_growfs")
+ ("mkfs.ext4" "e2fsprogs" "sbin/mkfs.ext4")
+ ("tune2fs" "e2fsprogs" "sbin/tune2fs")
+ ("blkid" "util-linux" "sbin/blkid")
+ ("resize2fs" "e2fsprogs" "sbin/resize2fs")
+ ("ps" "procps" "bin/ps")
+ ("losetup" "util-linux" "sbin/losetup")
+ ("uname" "coreutils" "bin/uname")
+ ("dbus-launch" "dbus" "bin/dbus-launch")
+ ("git" "git" "bin/git")))
+ ;; docker-mountfrom ??
+ ;; docker
+ ;; docker-untar ??
+ ;; docker-applyLayer ??
+ ;; /usr/bin/uname
+ ;; grep
+ ;; apparmor_parser
+
;; Make compilation fail when, in future versions, Docker
;; invokes other programs we don't know about and thus don't
;; substitute.
- branch master updated (7a31d93 -> 59781b3), guix-commits, 2019/05/05
- 03/07: gnu: docker: Harmonize LookPath regexes., guix-commits, 2019/05/05
- 02/07: gnu: docker: Cleanup extraneous comments., guix-commits, 2019/05/05
- 04/07: gnu: docker: Make macros use a relative path as argument., guix-commits, 2019/05/05
- 05/07: gnu: docker: Optimize substitution macros.,
guix-commits <=
- 01/07: gnu: docker: Fix indentation., guix-commits, 2019/05/05
- 07/07: gnu: docker: Refer to xz by its absolute path., guix-commits, 2019/05/05
- 06/07: gnu: docker: Patch the reference to the docker proxy., guix-commits, 2019/05/05