Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-07 05:06:37 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

39
lib/chibi/modules.scm
View file

@ -168,21 +168,34 @@
(else (else
(lp res))))))))) (lp res)))))))))
(define (available-modules-in-directory dir) (define no-module-depth-limit 2)
(directory-fold-tree
dir #f #f (define (available-modules-in-directory dir depth res)
(lambda (file res) (call-with-values
(if (module-file? file) (lambda ()
(append (read-static-modules file) res) (partition file-directory?
res)) (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) (define (available-modules)
(reverse (let lp ((ls (current-module-path)) (res *modules*))
(apply append (if (null? ls)
*modules* res
(map available-modules-in-directory (lp (cdr ls)
(current-module-path))))) (available-modules-in-directory (car ls) 0 res)))))
(define (modules-exporting-identifier name) (define (modules-exporting-identifier name)
(let lp ((ls (available-modules)) (let lp ((ls (available-modules))

2
lib/chibi/modules.sld
View file

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