48 lines
1.5 KiB
Scheme
48 lines
1.5 KiB
Scheme
|
|
(module hiding mzscheme
|
|
(provide (all-defined))
|
|
|
|
(define (scheme-module? mpi)
|
|
(let ([abs (find-absolute-module-path mpi)])
|
|
(and abs
|
|
(or (base-module-path? abs)
|
|
(scheme-lib-module-path? abs)))))
|
|
|
|
(define (lib-module? mpi)
|
|
(let ([abs (find-absolute-module-path mpi)])
|
|
(and abs (lib-module-path? abs))))
|
|
|
|
(define (find-absolute-module-path mpi)
|
|
(and (module-path-index? mpi)
|
|
(let-values ([(path rel) (module-path-index-split mpi)])
|
|
(cond [(and (pair? path) (memq (car path) '(quote lib planet)))
|
|
path]
|
|
[(symbol? path) path]
|
|
[(string? path) (find-absolute-module-path rel)]
|
|
[else #f]))))
|
|
|
|
(define (base-module-path? mp)
|
|
(and (pair? mp)
|
|
(eq? 'quote (car mp))
|
|
(regexp-match #rx"^#%" (symbol->string (cadr mp)))))
|
|
|
|
(define (scheme-lib-module-path? mp)
|
|
(cond [(symbol? mp)
|
|
(scheme-collection-name? (symbol->string mp))]
|
|
[(and (pair? mp) (eq? (car mp) 'lib))
|
|
(cond [(string? (cadr mp)) (null? (cddr mp))
|
|
(scheme-collection-name? (cadr mp))]
|
|
[(symbol? (cadr mp))
|
|
(scheme-collection-name? (symbol->string (cadr mp)))]
|
|
[else #f])]
|
|
[else #f]))
|
|
|
|
(define (scheme-collection-name? path)
|
|
(or (regexp-match? #rx"^scheme(/.)?" path)
|
|
(regexp-match? #rx"^mzscheme(/.)?" path)))
|
|
|
|
(define (lib-module-path? mp)
|
|
(or (symbol? mp)
|
|
(and (pair? mp) (memq (car mp) '(lib planet)))))
|
|
)
|