suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Reorganize module and function names to reflect file tree work.

Browse Source 
svn: r17547
This commit is contained in:
Eli Barzilay 2010-01-07 20:47:41 +00:00
parent 6199fc8867
commit 133f378991
2 changed files with 12 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/meta/tree/plt-tree.ss → collects/meta/tree/file-tree.ss
View File

@ -1,13 +1,13 @@
#lang scheme/base
(provide get-tree get-plt-tree)
(provide get-file-tree get-plt-file-tree)
(require "tree.ss" setup/dirs)
;; ----------------------------------------------------------------------------
;; Reading a tree from a directory
(define (get-tree path)
(define (get-file-tree path)
(define path* (simplify-path path))
(let loop ([path path*]
[name (regexp-replace #rx#"/$" (path->bytes path*) #"")])
@ -24,28 +24,28 @@
subs)))
path)]
[(file-exists? path) (make-tree name #f path)]
[else (error 'get-tree "bad path encountered: ~a/~a"
[else (error 'get-file-tree "bad path encountered: ~a/~a"
(current-directory) path)])))
;; ----------------------------------------------------------------------------
;; Reading the PLT tree
(define (get-plt-tree)
(define (get-plt-file-tree)
(when absolute-installation?
(error 'get-plt-tree "must be used from a relative installation"))
(get-tree (build-path (find-collects-dir) 'up)))
(get-file-tree (build-path (find-collects-dir) 'up)))
#| good for benchmarking changes
(printf "getting tree ")
(define t (time (get-plt-tree)))
(define t (time (get-plt-file-tree)))
;;!!! (printf "adding deps ")
;;!!! (time (add-deps! t))
(printf "filtering x 1000 ")
(time
(for ([i (in-range 1000)]) ; print-tree
(for ([i (in-range 1000)])
(tree-filter
(not: (or: "**/.svn/" "**/compiled/"))
;; (get-tree "/home/scheme/plt/collects/scribble/.svn")
;; (get-file-tree "/home/scheme/plt/collects/scribble/.svn")
t
)))
|#

8
collects/meta/tree/tests.ss
View File

@ -2,8 +2,8 @@
(require tests/eli-tester scheme/sandbox scheme/runtime-path scheme/file)
(define-runtime-path tree-module "tree.ss")
(define-runtime-path plt-tree-module "plt-tree.ss")
(define-runtime-path tree-module "tree.ss")
(define-runtime-path file-tree-module "file-tree.ss")
(define (glob-tests)
(define e
@ -48,7 +48,7 @@
(define (tree-tests)
(define e
(call-with-trusted-sandbox-configuration
(lambda () (make-module-evaluator plt-tree-module))))
(lambda () (make-module-evaluator file-tree-module))))
(define a-dir (collection-path "scribble"))
(define a-list (find-files void a-dir))
(define a-tree #f)
@ -124,7 +124,7 @@
=> '(-/ -/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)))
(set! a-tree (e `(get-file-tree ,a-dir)))
(e `(map tree-path (tree->list ,a-tree)))
=> a-list
(e/filter #"*")