From: ludo@gnu.org (Ludovic Courtès)
To: Christopher Baines <mail@cbaines.net>
Cc: guix-devel@gnu.org
Subject: Re: [PATCH] git-download: Speed up 'git-predicate'.
Date: Wed, 21 Jun 2017 23:44:26 +0200 [thread overview]
Message-ID: <87fuetggn9.fsf@gnu.org> (raw)
In-Reply-To: <20170619071443.23122-1-mail@cbaines.net> (Christopher Baines's message of "Mon, 19 Jun 2017 08:14:43 +0100")
Hello,
Christopher Baines <mail@cbaines.net> skribis:
> +(define (create-directory-tree files)
> + (define (directory-lists->tree directory-lists)
> + (map (lambda (top-level-dir)
> + (cons top-level-dir
> + (directory-lists->tree
> + (filter-map
> + (lambda (directory-list)
> + (if (eq? (length directory-list) 1)
> + #f
> + (cdr directory-list)))
> + ;; Find all the directory lists under this top-level-dir
> + (filter
> + (lambda (directory-list)
> + (equal? (car directory-list)
> + top-level-dir))
> + directory-lists)))))
> + (delete-duplicates
> + (map car directory-lists))))
> +
> + (directory-lists->tree
> + (filter-map (lambda (path)
> + (let ((split-path (string-split path #\/)))
> + ;; If this is a file in the top of the repository?
> + (if (eq? (length split-path) 1)
> + #f
> + ;; drop-right to remove the filename, as it's
> + ;; just the directory tree that's important
> + (drop-right (string-split path #\/) 1))))
> + files)))
> +
> +(define (directory-in-tree? directory whole-tree)
> + (define directory-list-in-tree?
> + (match-lambda*
> + (((top-directory . rest) tree)
> + (if (null? rest)
> + (list? (member top-directory (map car tree)))
> + (and=> (find (match-lambda
> + ((subtree-top-directory . subtree)
> + (equal? subtree-top-directory
> + top-directory)))
> + tree)
> + (match-lambda
> + ((subtree-top-directory . subtree)
> + (directory-list-in-tree? rest subtree))))))))
> +
> + (directory-list-in-tree? (string-split directory #\/)
> + whole-tree))
I tried it to fully understand what was going on. While playing with it
I came up with a variant that is slightly more concise and clearer (at
least to me ;-)):
--8<---------------cut here---------------start------------->8---
(define (files->directory-tree files)
"Return a tree of vhashes representing the directory listed in FILES, a list
like '(\"a/b\" \"b/c/d\")."
(fold (lambda (file result)
(let loop ((file (string-split file #\/))
(result result))
(match file
((_)
result)
((directory children ...)
(match (vhash-assoc directory result)
(#f
(vhash-cons directory (loop children vlist-null)
result))
((_ . previous)
;; XXX: 'vhash-delete' is O(n).
(vhash-cons directory (loop children previous)
(vhash-delete directory result)))))
(()
result))))
vlist-null
files))
(define (directory-in-tree? tree directory)
"Return true if DIRECTORY, a string like \"a/b\", denotes a directory listed
in TREE."
(let loop ((directory (string-split directory #\/))
(tree tree))
(match directory
(()
#t)
((head . tail)
(match (vhash-assoc head tree)
((_ . sub-tree) (loop tail sub-tree))
(#f #f))))))
--8<---------------cut here---------------end--------------->8---
The tree is a tree of vhash, which should make lookup (i.e.,
‘directory-in-tree?’) slightly faster. So it works like this:
--8<---------------cut here---------------start------------->8---
scheme@(guile-user)> (files->directory-tree '("a" "a/b" "a/b/x" "a/c" "b" "b/c"))
$17 = #<vhash 2802a40 2 pairs>
scheme@(guile-user)> (directory-in-tree? $17 "a/b")
$18 = #t
scheme@(guile-user)> (directory-in-tree? $17 "a")
$19 = #t
scheme@(guile-user)> (directory-in-tree? $17 "a/b/x")
$21 = #f
scheme@(guile-user)> (directory-in-tree? $17 "a/c")
$22 = #f
scheme@(guile-user)> (directory-in-tree? $17 "b")
$23 = #t
--8<---------------cut here---------------end--------------->8---
WDYT? If you like it, take it and adjust as you see fit. We’re doing
4-hand coding like whichever fancy methodology recommends. ;-)
Ludo’.
next prev parent reply other threads:[~2017-06-21 21:44 UTC|newest]
Thread overview: 13+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-06-02 7:08 [PATCH] git-download: Speed up 'git-predicate' Christopher Baines
2017-06-02 7:34 ` Christopher Baines
2017-06-07 12:40 ` Ludovic Courtès
2017-06-07 18:12 ` Christopher Baines
2017-06-07 12:52 ` Ludovic Courtès
2017-06-08 20:43 ` Christopher Baines
2017-06-19 7:14 ` Christopher Baines
2017-06-21 21:44 ` Ludovic Courtès [this message]
2017-07-16 10:42 ` Christopher Baines
2017-07-25 21:26 ` Ludovic Courtès
2017-07-26 9:58 ` Christopher Baines
2017-06-19 7:24 ` Christopher Baines
2017-06-21 21:17 ` Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87fuetggn9.fsf@gnu.org \
--to=ludo@gnu.org \
--cc=guix-devel@gnu.org \
--cc=mail@cbaines.net \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.