diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-09-23 21:01:17 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-09-23 22:23:47 +0200 |
commit | 0c0142881f769b6c42a8a69bec490ba9e98ccf48 (patch) | |
tree | 515f790266a701a590f04ea589436c54ed3c44b7 /scripts/all-modules.scm | |
parent | Move graphviz to main tree. (diff) | |
download | calp-0c0142881f769b6c42a8a69bec490ba9e98ccf48.tar.gz calp-0c0142881f769b6c42a8a69bec490ba9e98ccf48.tar.xz |
Move all generally usable scripts to module dir.
Diffstat (limited to 'scripts/all-modules.scm')
-rw-r--r-- | scripts/all-modules.scm | 55 |
1 files changed, 0 insertions, 55 deletions
diff --git a/scripts/all-modules.scm b/scripts/all-modules.scm deleted file mode 100644 index 23bbb32d..00000000 --- a/scripts/all-modules.scm +++ /dev/null @@ -1,55 +0,0 @@ -(define-module (all-modules) - :use-module (ice-9 regex) - :use-module (srfi srfi-1) - :use-module (ice-9 ftw) - :use-module (ice-9 match) - :use-module (hnh util path) - :use-module (module-introspection) - :use-module ((static-util) :select (get-forms)) - :export (all-files-and-modules-under-directory - all-modules-under-directory - fs-find-base fs-find - module-file-mapping - )) - -(define (fs-find dir) - (define files '()) - (ftw dir (lambda args (set! files (cons args files)) #t)) - files) - -;; (define (fs-find proc dir) -;; (filter proc (fs-find-base dir))) - -(define (all-files-and-modules-under-directory dir) - (define re (make-regexp "\\.scm$")) - - (define files - (map car - (filter (match-lambda ((filename _ 'regular) - (and (regexp-exec re filename) - (not (file-hidden? filename)))) - (_ #f)) - (fs-find dir)))) - - (map (lambda (file) - (list file - (call-with-input-file file - (compose find-module-declaration get-forms)))) - files)) - -(define (all-modules-under-directory dir) - "Returns two values, all scm files in dir, and all top -level modules in those files" - - (define pairs (all-files-and-modules-under-directory dir)) - (values - (map car pairs) - (filter identity (map cadr pairs)))) - -;; Returns an association list from module names the modules -;; containing filename -(define (module-file-mapping dir) - (filter - car - (map (lambda (pair) (cons (cadr pair) (car pair))) - (all-files-and-modules-under-directory dir)))) |