From a01d54f3bdc5bd8d11fdc82ac5d14a974f6c5a86 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Sat, 13 Apr 2019 22:00:45 -0400 Subject: 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 e8a742bfe1..c1a99c9347 100644 --- a/gnu/packages/docker.scm +++ b/gnu/packages/docker.scm @@ -366,68 +366,66 @@ (define-public 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 "\\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 "\\