* Including full path for each node in the tree -- this means that any

subtree is complete with no need to rehack its root.  Simplifies a
  bunch of code, and makes some utilities redundant.
* Using a single struct for all nodes, with subs=#f to mark files
* Names of struct is generic, no relation to actual files and dirs
* Added more tests

svn: r17527

collects/meta/tree/plt-tree.ss

@@ -1,6 +1,6 @@
 #lang scheme/base
 
-(require setup/dirs "tree.ss")
+(require "tree.ss" setup/dirs)
 
 (define (get-plt-tree)
   (when absolute-installation?
@@ -8,9 +8,11 @@
   (get-tree (build-path (find-collects-dir) 'up)))
 
 #| good for benchmarking changes
-(printf "getting tree\n")
+(printf "getting tree ")
-(define t (get-plt-tree))
+(define t (time (get-plt-tree)))
-(printf "filtering\n")
+;;!!! (printf "adding deps ")
+;;!!! (time (add-deps! t))
+(printf "filtering x 1000 ")
 (time
  (for ([i (in-range 1000)]) ; print-tree
    (tree-filter

collects/meta/tree/tests.ss

@@ -46,52 +46,86 @@
 
 (define (tree-tests)
   (define a-dir  (collection-path "scribble"))
-  (define a-list (map (lambda (p)
+  (define a-list (find-files void a-dir))
-                        (let ([r (path->bytes p)])
-                          (if (directory-exists? p) (bytes-append r #"/") r)))
-                      (find-files void a-dir)))
   (define a-tree #f)
   (define (->bytes x) (string->bytes/utf-8 (format "~a" x)))
   (define same-as-last-datums #f)
   (define datums-result #f)
   (define (->datums xs)
     (set! same-as-last-datums datums-result)
-    (set! datums-result (map (lambda (x) (read (open-input-bytes x))) xs))
+    (set! datums-result
+          (map (lambda (x)
+                 (read (open-input-bytes (if (path? x) (path->bytes x) x))))
+               xs))
     datums-result)
-  (define (mk-tree t)
+  (define (mk-tree t [convert values])
-    (e (let loop ([t t])
+    (e (let loop ([t t] [path #""])
-         (if (pair? t)
+         (let* ([subs? (pair? t)]
-           `(make-dir ,(regexp-replace #rx#"/?$" (->bytes (car t)) #"/")
+                [name (->bytes (if subs? (car t) t))]
-                      (list ,@(map loop (cdr t))))
+                [name (if subs? (regexp-replace #rx#"/?$" name #"/") name)]
-           `(make-file ,(->bytes t))))))
+                [path (bytes-append path name)])
-  (test (set! a-tree (mk-tree '(- 0 (A1 1 2 3 (B 4) C) (A2 5))))
+           (if subs?
-        (->datums (e `(map tree-name (tree->list ,a-tree))))
+             `(make-tree ,name
-        => '(-/ 0 A1/ 1 2 3 B/ 4 C A2/ 5)
+                         (list ,@(map (lambda (s) (loop s path)) (cdr t)))
-        (->datums (e `(tree->path-list ,a-tree)))
+                         ,(convert path))
-        => '(-/ -/0 -/A1/ -/A1/1 -/A1/2 -/A1/3 -/A1/B/ -/A1/B/4 -/A1/C
+             `(make-tree ,name #f ,(convert path)))))))
-                -/A2/ -/A2/5)
+  (define (e/filter filter)
-        (->datums (e `(tree->path-list (tree-filter #"*" ,a-tree))))
+    (->datums (e `(map tree-path (tree->list (tree-filter ,filter ,a-tree))))))
-        => same-as-last-datums
+  (test
-        (->datums (e `(tree->path-list (tree-filter #"A2/" ,a-tree))))
+   ;; works with paths...
-        => '(-/ -/A2/ -/A2/5)
+   (set! a-tree (mk-tree '(- 0 (A1 1 2 3 (B 4) C) (A2 5)) bytes->path))
-        (->datums (e `(tree->path-list (tree-filter #"A1/B/" ,a-tree))))
+   (->datums (e `(map tree-name (tree->list ,a-tree))))
-        => '(-/ -/A1/ -/A1/B/ -/A1/B/4)
+   => '(-/ 0 A1/ 1 2 3 B/ 4 C A2/ 5)
-        ;; works with string patterns too
+   ;; ...as well as bytes
-        (->datums (e `(tree->path-list (tree-filter "A1/B/" ,a-tree))))
+   (set! a-tree (mk-tree '(- 0 (A1 1 2 3 (B 4) C) (A2 5))))
-        => same-as-last-datums
+   (->datums (e `(map tree-name (tree->list ,a-tree))))
-        ;; last "/" is optional here ...
+   => same-as-last-datums
-        (->datums (e `(tree->path-list (tree-filter "A1/B" ,a-tree))))
+   (->datums (e `(map tree-path (tree->list ,a-tree))))
-        => same-as-last-datums
+   => '(-/ -/0 -/A1/ -/A1/1 -/A1/2 -/A1/3 -/A1/B/ -/A1/B/4 -/A1/C -/A2/ -/A2/5)
-        ;; ... but in general it forces matching only directories
+   (->datums (e `(map tree-path (tree-foldr cons '() ,a-tree))))
-        (->datums (e `(tree->path-list (tree-filter "A1/?/" ,a-tree))))
+   => same-as-last-datums
-        => same-as-last-datums
+   (->datums (e `(map tree-path (reverse (tree-foldl cons '() ,a-tree)))))
-        (->datums (e `(tree->path-list (tree-filter "A1/?" ,a-tree))))
+   => same-as-last-datums
-        => '(-/ -/A1/ -/A1/1 -/A1/2 -/A1/3 -/A1/B/ -/A1/B/4 -/A1/C)
+   (->datums (e `(let ([l '()])
-        (set! a-tree (e `(get-tree ,a-dir)))
+                   (tree-for-each (lambda (t) (set! l (cons (tree-path t) l)))
-        (e `(tree->path-list ,a-tree))
+                                  ,a-tree)
-        => a-list
+                   (reverse l))))
-        (e `(tree->path-list (tree-filter #"*" ,a-tree)))
+   => same-as-last-datums
-        => a-list)
+   (e/filter #"*")
+   => same-as-last-datums
+   (e/filter #"A2/")
+   => '(-/ -/A2/ -/A2/5)
+   (e/filter #"A1/B/")
+   => '(-/ -/A1/ -/A1/B/ -/A1/B/4)
+   ;; works with string patterns too
+   (e/filter "A1/B/")
+   => same-as-last-datums
+   ;; last "/" is optional here ...
+   (e/filter "A1/B")
+   => same-as-last-datums
+   ;; ... but in general it forces matching only directories
+   (e/filter "A1/?/")
+   => same-as-last-datums
+   (e/filter "A1/?")
+   => '(-/ -/A1/ -/A1/1 -/A1/2 -/A1/3 -/A1/B/ -/A1/B/4 -/A1/C)
+   (e/filter "*/2")
+   => '(-/ -/A1/ -/A1/2)
+   (e/filter "*/[25]")
+   => '(-/ -/A1/ -/A1/2 -/A2/ -/A2/5)
+   (e/filter "*/{2|5}")
+   => same-as-last-datums
+   (e/filter '(not: "*/2"))
+   => '(-/ -/0 -/A1/ -/A1/1 -/A1/3 -/A1/B/ -/A1/B/4 -/A1/C -/A2/ -/A2/5)
+   (e/filter '(not: "*/[25]"))
+   => '(-/ -/0 -/A1/ -/A1/1 -/A1/3 -/A1/B/ -/A1/B/4 -/A1/C -/A2/)
+   (e/filter '(not: "*/{2|5}"))
+   => '(-/ -/0 -/A1/ -/A1/1 -/A1/3 -/A1/B/ -/A1/B/4 -/A1/C -/A2/)
+   (set! a-tree (e `(get-tree ,a-dir)))
+   (e `(map tree-path (tree->list ,a-tree)))
+   => a-list
+   (e/filter #"*")
+   => (->datums a-list)
+   )
   (set! a-tree
         (mk-tree '(-
                    (.svn
@@ -746,7 +780,7 @@
                    xref.ss)))
   (test
    ;; the whole tree
-   (->datums (e `(tree->path-list (tree-filter "*" ,a-tree))))
+   (e/filter "*")
    =>
    '(
      -/
@@ -1402,7 +1436,7 @@
      -/xref.ss
      )
    ;; no immediate files
-   (->datums (e `(tree->path-list (tree-filter "*/*" ,a-tree))))
+   (e/filter "*/*")
    =>
    '(-/
      -/.svn/
@@ -2009,10 +2043,10 @@
      -/tools/private/compiled/mk-drs-bitmaps_ss.zo
      -/tools/private/mk-drs-bitmaps.ss
      )
-   (->datums (e `(tree->path-list (tree-filter "*/" ,a-tree))))
+   (e/filter "*/")
    => same-as-last-datums
    ;; only 2-levels and deeper
-   (->datums (e `(tree->path-list (tree-filter "*/*/*" ,a-tree))))
+   (e/filter "*/*/*")
    =>
    '(-/
      -/.svn/
@@ -2506,7 +2540,7 @@
      -/tools/private/mk-drs-bitmaps.ss
      )
    ;; only 3-levels and deeper
-   (->datums (e `(tree->path-list (tree-filter "*/*/*/*" ,a-tree))))
+   (e/filter "*/*/*/*")
    =>
    '(-/
      -/base/
@@ -2779,7 +2813,7 @@
      -/tools/private/compiled/mk-drs-bitmaps_ss.zo
      )
    ;; only 4-levels and deeper
-   (->datums (e `(tree->path-list (tree-filter "*/*/*/*/*" ,a-tree))))
+   (e/filter "*/*/*/*/*")
    =>
    '(-/
      -/base/
@@ -2863,7 +2897,7 @@
      -/tools/private/.svn/tmp/text-base/
      )
    ;; only 4-levels and deeper of directories, including empty ones
-   (->datums (e `(tree->path-list (tree-filter "*/*/*/*/" ,a-tree))))
+   (e/filter "*/*/*/*/")
    =>
    '(-/
      -/base/
@@ -2995,13 +3029,13 @@
      -/tools/private/.svn/tmp/text-base/
      )
    ;; only 5-levels and deeper => nothing
-   (->datums (e `(tree->path-list (tree-filter "*/*/*/*/*/*" ,a-tree))))
+   (e/filter "*/*/*/*/*/*")
    => '(-/)
    ;; only 6-levels and deeper => nothing
-   (->datums (e `(tree->path-list (tree-filter "*/*/*/*/*/*/*" ,a-tree))))
+   (e/filter "*/*/*/*/*/*/*")
    => '(-/)
    ;; only immediate files
-   (->datums (e `(tree->path-list (tree-filter (not: "*/") ,a-tree))))
+   (e/filter '(not: "*/"))
    =>
    '(-/
      -/base-render.ss
@@ -3056,7 +3090,7 @@
    ;; dropped -- but for negated predicates the default is to keep empty
    ;; directories, so the result is the same as the above but also includes
    ;; directories
-   (->datums (e `(tree->path-list (tree-filter (not: "*/*") ,a-tree))))
+   (e/filter '(not: "*/*"))
    =>
    '(
      -/
@@ -3119,13 +3153,11 @@
      -/xref.ss
      )
    ;; (not: (not: pred)) returns `pred'
-   (->datums (e `(tree->path-list (tree-filter (not: (not: (not: "*/*")))
+   (e/filter '(not: (not: (not: "*/*"))))
-                                               ,a-tree))))
    => same-as-last-datums
    ;; the special treatment of negated predicates makes it possible to select
    ;; only toplevel directories too
-   (->datums (e `(tree->path-list (tree-filter (and: "*/" (not: "*/*"))
+   (e/filter '(and: "*/" (not: "*/*")))
-                                               ,a-tree))))
    =>
    '(
      -/
@@ -3141,11 +3173,10 @@
      -/tools/
      )
    ;; demorgan works with this negation
-   (->datums (e `(tree->path-list (tree-filter (not: (or: (not: "*/") "*/*"))
+   (e/filter '(not: (or: (not: "*/") "*/*")))
-                                               ,a-tree))))
    => same-as-last-datums
    ;; only compiled directories
-   (->datums (e `(tree->path-list (tree-filter "**/compiled/" ,a-tree))))
+   (e/filter "**/compiled/")
    =>
    '(-/
      -/base/
@@ -3330,9 +3361,7 @@
      -/tools/private/compiled/mk-drs-bitmaps_ss.zo
      )
    ;; only compiled directories but not their content
-   (->datums (e `(tree->path-list (tree-filter (and: "**/compiled/"
+   (e/filter '(and: "**/compiled/" (not: "**/compiled/*")))
-                                                     (not: "**/compiled/*"))
-                                               ,a-tree))))
    =>
    '(-/
      -/base/
@@ -3367,7 +3396,7 @@
      -/tools/private/compiled/
      )
    ;; only .dep files in compiled directories
-   (->datums (e `(tree->path-list (tree-filter "**/compiled/*.dep" ,a-tree))))
+   (e/filter "**/compiled/*.dep")
    =>
    '(-/
      -/base/
@@ -3477,12 +3506,10 @@
      -/tools/private/compiled/mk-drs-bitmaps_ss.dep
      )
    ;; only .dep files in compiled directories, by dropping .zo files
-   (->datums (e `(tree->path-list (tree-filter (and: "**/compiled/"
+   (e/filter '(and: "**/compiled/" (not: "**/*.zo")))
-                                                     (not: "**/*.zo"))
-                                               ,a-tree))))
    => same-as-last-datums
    ;; no .svn directories
-   (->datums (e `(tree->path-list (tree-filter (not: "**/.svn/") ,a-tree))))
+   (e/filter '(not: "**/.svn/"))
    =>
    '(-/
      -/base/
@@ -3760,8 +3787,7 @@
      -/xref.ss
      )
    ;; no .svn or compiled directories using "{|}"
-   (->datums (e `(tree->path-list (tree-filter (not: "**/{.svn|compiled}/")
+   (e/filter '(not: "**/{.svn|compiled}/"))
-                                               ,a-tree))))
    =>
    '(-/
      -/base/
@@ -3874,14 +3900,10 @@
      -/xref.ss
      )
    ;; no .svn or compiled directories using `or:'
-   (->datums (e `(tree->path-list
+   (e/filter '(not: (or: "**/.svn/" "**/compiled/")))
-                  (tree-filter (not: (or: "**/.svn/" "**/compiled/"))
-                               ,a-tree))))
    => same-as-last-datums
    ;; no .svn or compiled directories using `and:'
-   (->datums (e `(tree->path-list
+   (e/filter '(and: (not: "**/.svn/") (not: "**/compiled/")))
-                  (tree-filter (and: (not: "**/.svn/") (not: "**/compiled/"))
-                               ,a-tree))))
    => same-as-last-datums))
 
 (test do (glob-tests)

collects/meta/tree/tree.ss

@@ -1,72 +1,65 @@
 #lang scheme/base
 
-(provide tree-foldl tree-foldr tree-for-each print-tree
+(provide (struct-out tree) leaf? tree-foldl tree-foldr tree-for-each tree->list
-         tree->list tree->path-list and: or: not: tree-filter get-tree
+         and: or: not: tree-filter get-tree)
-         (struct-out tree) (struct-out file) (struct-out dir))
 
 (require scheme/list)
 
 ;; ----------------------------------------------------------------------------
 ;; Type definitions
 
-(define-struct tree (name [data #:auto #:mutable]))
+;; This is a generic tree representation, subs is a list of subtrees, or #f for
-(define-struct (file tree) ())
+;; a leaf.
-(define-struct (dir tree) (subs))
+;; - `name' is a name for this tree as a byte string, with a "/" suffix for
+;;   non-leaf nodes (the filtering code relies on this assumption)
+;; - `subs' is a list of subtrees, or #f to mark a leaf
+;; - `path' is the full path for to this tree (eg, FS path or a subvesion url),
+;;   this code has no assumptions on what's in there
+;; - `data' is a placeholder for additional data
+
+(define-struct tree (name subs path [data #:auto #:mutable]))
+(define-syntax-rule (leaf? tree) (not (tree-subs tree)))
 
 ;; ----------------------------------------------------------------------------
 ;; Tree utilities
 
 (define (tree-foldl f init tree)
-  (let loop ([tree tree] [base #""] [acc init])
+  (let loop ([tree tree] [acc init])
-    (if (file? tree)
+    (let ([subs (tree-subs tree)])
-      (f tree base acc)
+      (if subs
-      (let ([base* (bytes-append base (tree-name tree))])
+        (let dloop ([subs subs] [acc (f tree acc)])
-        (let dloop ([trees (dir-subs tree)] [acc (f tree base acc)])
+          (if (null? subs)
-          (if (null? trees)
             acc
-            (dloop (cdr trees) (loop (car trees) base* acc))))))))
+            (dloop (cdr subs) (loop (car subs) acc))))
+        (f tree acc)))))
 
 (define (tree-foldr f init tree)
-  (let loop ([tree tree] [base #""] [acc init])
+  (let loop ([tree tree] [acc init])
-    (f tree base
+    (let ([subs (tree-subs tree)])
-       (if (file? tree)
+      (f tree (if subs
-         acc
+                (let dloop ([subs subs])
-         (let ([base* (bytes-append base (tree-name tree))])
+                  (if (null? subs)
-           (let dloop ([trees (dir-subs tree)])
+                    acc
-             (if (null? trees)
+                    (loop (car subs) (dloop (cdr subs)))))
-               acc
+                acc)))))
-               (loop (car trees) base* (dloop (cdr trees))))))))))
 
 (define (tree-for-each f tree)
-  (let loop ([tree tree] [base #""])
+  (let loop ([tree tree])
-    (f tree base)
+    (f tree)
-    (when (dir? tree)
+    (let ([subs (tree-subs tree)])
-      (let ([base* (bytes-append base (tree-name tree))])
+      (when subs (for-each loop subs)))))
-        (for ([tree (in-list (dir-subs tree))]) (loop tree base*))))))
 
-(define (print-tree tree)
+(define (tree->list tree) (tree-foldr cons '() tree))
-  (tree-for-each
-   (lambda (tree base)
-     (write-bytes base) (write-bytes (tree-name tree)) (newline))
-   tree))
-
-(define (tree->list tree)
-  (tree-foldr (lambda (tree base acc) (cons tree acc)) '() tree))
-
-(define (tree->path-list tree)
-  (tree-foldr (lambda (tree base acc)
-                         (cons (bytes-append base (tree-name tree)) acc))
-                       '() tree))
 
 ;; ----------------------------------------------------------------------------
 ;; Tree filtering
 
 ;; A tree-filtering predicate is a function that receives a tree, and returns
 ;; either #t/#f to include or exclude it, or it can return a function to be
-;; applied on the sub-trees of a directory.  This setup makes it possible to
+;; applied on its sub-trees.  This setup makes it possible to minimize the
-;; minimize the filtering work that is needed (compared to the old code that
+;; filtering work that is needed (compared to the old code that would compare
-;; would compare full paths).  `tree-filter' takes such a predicate and returns
+;; full paths).  `tree-filter' takes such a predicate and returns a tree with
-;; a tree with filtered subtrees, so the smallest result is the empty root.
+;; filtered subtrees, so the smallest result is the empty root.
 
 ;; Turns a byte string with globbing into a regexp string.  "*" turns to ".*",
 ;; "?" turns to ".", "[...]" ranges are used as is, "{...|...}" turns to
@@ -123,41 +116,44 @@
                    (regexp-split #rx#"(?<=/)" glob))])
     ;; - xs is never null (`regexp-split' never returns null)
     ;; - an element without a trailing slash must be the last one
-    ;; - an element with a trailing slash matches directories only, need to use
+    ;; - an element with a trailing slash matches non-leaf nodes only, so need
-    ;;   `dir?' for `*/' and `**/'
+    ;;   to test subs for `*/' and `**/'
     ;; - things usually work out fine, but if it's the last element, then we
     ;;   better return #t or #f rather a continuation predicate, since a
     ;;   predicate result will never be used and it will mess up (eg, a
-    ;;   predicate result for a file is considered true, but (not: (lambda (t)
+    ;;   predicate result for a leaf is considered true, but (not: (lambda (t)
     ;;   #t)) is also a predicate) => use #t for `r' in this case
     (let* ([x  (car xs)]
            [x* (glob->regexp-or-literal x)]
            [xs (cdr xs)]
            [r  (or (null? xs) (loop xs))])
       (cond
-        [(eq? '*   x*) (lambda (t) #t)]
+        [(eq? '*   x*) (lambda (t) #t)] ; it's the last one
-        [(eq? '*/  x*) (lambda (t) (and (dir? t) r))]
+        [(eq? '*/  x*) (lambda (t) (and (tree-subs t) r))]
         [(eq? '**  x*) (lambda (t) #t)]
-        [(eq? '**/ x*) (letrec ([R (or: r (lambda (t) (and (dir? t) R)))]) R)]
+        [(eq? '**/ x*) (letrec ([R (or: r (lambda (t) (and (tree-subs t) R)))])
+                         R)]
         ;; if it's the last one and it has no "/" suffix then it will match
-        ;; only files => in this case, allow matches on directories by adding
+        ;; only leaves => in this case, allow matches on non-leaf nodes by
-        ;; the "/" (if this is not done then directories must always be
+        ;; adding the "/" (if this is not done then it's very easy to make
-        ;; specified with a trailing slash, which is easy to forget)
+        ;; mistakes)
         [else
-         (let ([x*/
+         (let ([x*/ (cond [(or (pair? xs) (regexp-match? #rx#"/$" x)) #f]
-                (cond [(or (pair? xs) (regexp-match? #rx#"/$" x)) #f]
+                          [(bytes? x*) (bytes-append x* #"/")]
-                      [(bytes? x*) (bytes-append x* #"/")]
+                          [(byte-regexp? x*)
-                      [(byte-regexp? x*)
+                           (glob->regexp-or-literal (bytes-append x #"/"))]
-                       (glob->regexp-or-literal (bytes-append x #"/"))]
+                          [else (error 'glob->pred "bad glob part: ~e" x)])])
-                      [else (error 'glob->pred "bad glob element: ~e" x)])])
            (cond
              [(bytes? x*/)
-              (lambda (t) (and (equal? (if (dir? t) x*/ x*) (tree-name t)) r))]
+              (lambda (t)
+                (let ([x (if (tree-subs t) x*/ x*)])
+                  (and (equal? x (tree-name t)) r)))]
              [(byte-regexp? x*/)
               (lambda (t)
-                (and (regexp-match? (if (dir? t) x*/ x*) (tree-name t)) r))]
+                (let ([x (if (tree-subs t) x*/ x*)])
+                  (and (regexp-match? x (tree-name t)) r)))]
              [(bytes? x*)
-              (lambda (t) (and (dir? t) (equal? x* (tree-name t)) r))]
+              (lambda (t) (and (tree-subs t) (equal? x* (tree-name t)) r))]
              [(byte-regexp? x*)
               (lambda (t) (and (regexp-match? x* (tree-name t)) r))]))]))))
 
@@ -195,12 +191,13 @@
 (define-combiner or:  raw-or:  #f #t)
 
 ;; Negating predicates is a little tricky, for example (not: "*/*") would
-;; filter out everything in all subdirectories, and since empty directories are
+;; filter out everything in all subtrees, and since empty non-leaf nodes are
-;; usually dropped by `tree-filter', this means that the directories will be
+;; usually dropped by `tree-filter', this means that the containing trees will
-;; dropped too, leaving only immediate files.  The way to make this behave more
+;; be dropped too, leaving only immediate leaves.  The way to make this behave
-;; intuitively is to mark negated predicates, and when filtering with a negated
+;; more intuitively is to mark negated predicates, and when filtering with a
-;; predicate the default is to keep empty directories rather than drop them.
+;; negated predicate the default is to keep empty non-leaf nodes rather than
-;; (As an aside, this can also be used to make (not: (not: f)) return `f'.)
+;; drop them.  (As an aside, this can also be used to make (not: (not: f))
+;; return `f'.)
 (define-struct negated (pred orig) #:property prop:procedure 0)
 (define (raw-not: p)
   (if (negated? p)
@@ -214,48 +211,50 @@
 (define (not: pred/glob)
   (raw-not: (pred/glob->pred pred/glob)))
 
+;; filter a whole tree
 (define (tree-filter pred/glob tree)
   (define pred (pred/glob->pred pred/glob))
-  (define-syntax-rule (dir-filter pred dir)
+  (define (subs-filter pred tree)
     (let* ([same? #t]
-           [subs (dir-subs dir)]
+           [subs (tree-subs tree)]
            [new-subs (filter-map (lambda (sub)
                                    (let ([r (loop sub pred)])
                                      (unless (eq? r sub) (set! same? #f))
                                      r))
                                  subs)])
       (cond [(and (null? new-subs) (not (negated? pred))) #f]
-            [same? dir]
+            [same? tree]
-            [else (make-dir (tree-name dir) new-subs)])))
+            [else (make-tree (tree-name tree) new-subs (tree-path tree))])))
   (define (loop tree pred)
     (let ([r (pred tree)])
       (cond [(eq? #t r) tree]
             [(eq? #f r) #f]
-            [(procedure? r) (and (dir? tree) (dir-filter r tree))]
+            [(procedure? r) (and (tree-subs tree) (subs-filter r tree))]
             [else (error 'tree-filter "bad result from predicate: ~e" r)])))
-  (if (file? tree)
+  (if (leaf? tree)
-    (error 'tree-filter "expecting a `dir', got ~e" tree)
+    (error 'tree-filter "expecting a non-leaf, got ~e" tree)
-    (or (dir-filter pred tree) (make-dir (tree-name tree) '()))))
+    (or (subs-filter pred tree)
+        (make-tree (tree-name tree) '() (tree-path tree)))))
 
 ;; ----------------------------------------------------------------------------
 ;; Reading a tree from a directory
 
-(define (get-tree dir)
+(define (get-tree path)
-  (define (subs dir)
+  (define path* (simplify-path path))
-    (parameterize ([current-directory dir])
+  (let loop ([path path*]
-      (map cdr
+             [name (regexp-replace #rx#"/$" (path->bytes path*) #"")])
-           (sort
+    (cond [(directory-exists? path)
-            (for/list ([path (directory-list)])
+           (make-tree
-              (let ([name (path-element->bytes path)])
+            (bytes-append name #"/")
-                (cons name
+            (parameterize ([current-directory path])
-                      (cond
+              (let* ([subs (map (lambda (sub)
-                        [(directory-exists? path)
+                                  (cons (path-element->bytes sub) sub))
-                         (make-dir (bytes-append name #"/") (subs path))]
+                                (directory-list))]
-                        [(file-exists? path) (make-file name)]
+                     [subs (sort subs bytes<? #:key car)])
-                        [else (error 'get-tree "bad path encountered: ~a/~a"
+                (map (lambda (sub)
-                                     (current-directory) path)]))))
+                       (loop (build-path path (cdr sub)) (car sub)))
-            bytes<?
+                     subs)))
-            #:key car))))
+            path)]
-  (define root (path->bytes (simplify-path dir)))
+          [(file-exists? path) (make-tree name #f path)]
-  (make-dir (if (regexp-match? #rx#"/$" root) root (bytes-append root #"/"))
+          [else (error 'get-tree "bad path encountered: ~a/~a"
-            (subs dir)))
+                       (current-directory) path)])))