Prune directories from module search once we've gone two levels

without seeing any modules.
This commit is contained in:
Alex Shinn 2014-07-12 17:02:09 +09:00
parent bca1281acb
commit c160d03024
2 changed files with 27 additions and 14 deletions

View file

@ -168,21 +168,34 @@
(else
(lp res)))))))))
(define (available-modules-in-directory dir)
(directory-fold-tree
dir #f #f
(lambda (file res)
(if (module-file? file)
(append (read-static-modules file) res)
res))
'()))
(define no-module-depth-limit 2)
(define (available-modules-in-directory dir depth res)
(call-with-values
(lambda ()
(partition file-directory?
(map (lambda (f) (string-append dir "/" f))
(remove (lambda (f) (member f '("." "..")))
(directory-files dir)))))
(lambda (dirs files)
(let ((mods (append-map read-static-modules
(filter module-file? files))))
(if (and (null? mods) (>= depth no-module-depth-limit))
res
(let ((depth (if (pair? mods) 0 (+ 1 depth))))
(let lp ((ls dirs) (res (append mods res)))
(if (null? ls)
res
(lp (cdr ls)
(available-modules-in-directory (car ls) depth res)
)))))))))
(define (available-modules)
(reverse
(apply append
*modules*
(map available-modules-in-directory
(current-module-path)))))
(let lp ((ls (current-module-path)) (res *modules*))
(if (null? ls)
res
(lp (cdr ls)
(available-modules-in-directory (car ls) 0 res)))))
(define (modules-exporting-identifier name)
(let lp ((ls (available-modules))

View file

@ -6,5 +6,5 @@
module-name->file procedure-analysis find-module
available-modules-in-directory available-modules
modules-exporting-identifier)
(import (chibi) (meta) (chibi ast) (chibi filesystem))
(import (chibi) (meta) (srfi 1) (chibi ast) (chibi filesystem))
(include "modules.scm"))