diff options
Diffstat (limited to '')
| -rw-r--r--[-rwxr-xr-x] | module/scripts/module-dependants.scm (renamed from scripts/module-dependants.scm) | 96 |
1 files changed, 48 insertions, 48 deletions
diff --git a/scripts/module-dependants.scm b/module/scripts/module-dependants.scm index 87c1f40b..6bda1917 100755..100644 --- a/scripts/module-dependants.scm +++ b/module/scripts/module-dependants.scm @@ -1,9 +1,3 @@ -#!/usr/bin/env bash -GUILE=${GUILE:-guile} -set -x -exec $GUILE -e main -s "$0" "$@" -!# - ;;; Commentary: ;;; ;;; For a given module in the project, finds all other modules who uses that @@ -11,25 +5,24 @@ exec $GUILE -e main -s "$0" "$@" ;;; ;;; Code: -(define module-dir (string-append - (dirname (dirname (current-filename))) - "/module")) - -(add-to-load-path module-dir) -(add-to-load-path (dirname (current-filename))) - - -(use-modules (hnh util) - (hnh util path) - (srfi srfi-1) - (srfi srfi-71) - (ice-9 ftw) - (texinfo string-utils) - (module-introspection)) +(define-module (scripts module-dependants) + :use-module (hnh util) + :use-module (hnh util path) + :use-module (srfi srfi-1) + :use-module (srfi srfi-71) + :use-module (ice-9 ftw) + :use-module (ice-9 curried-definitions) + :use-module (ice-9 format) + :use-module (texinfo string-utils) + :use-module (hnh module-introspection) + :use-module ((hnh module-introspection static-util) :select (get-forms)) + :export (main)) + +(define %summary "Print all modules which depend on module specified in target file.") +(define %synopsis "module-dependants TARGET-FILE") (define cstat (make-object-property)) - (define (find-all-files-under directory) (file-system-fold ;; enter? @@ -53,16 +46,13 @@ exec $GUILE -e main -s "$0" "$@" (define (regular-file? filename) (eq? 'regular (stat:type (cstat filename)))) -(define (filename-extension? ext) - (let ((re (make-regexp (string-append ((@ (texinfo string-utils) - escape-special-chars) - ext "^$[]()*." #\\) - "$") regexp/icase))) - (lambda (filename) (regexp-exec re filename)))) +;; Does @var{filename} have the extension @var{ext}? +(define ((filename-extension? ext) filename) + (string=? ext (filename-extension filename))) -(define (main args) - (define target-file (realpath (cadr args))) +(define (main . args) + (define target-file (realpath (car args))) (define target-forms (reverse (call-with-input-file target-file get-forms))) (define target-module @@ -73,26 +63,36 @@ exec $GUILE -e main -s "$0" "$@" (define edges (concatenate (map (lambda (file) - (define forms (call-with-input-file file get-forms)) - (define module (and=> (-> forms find-module-declaration) resolve-module)) - (define source-symbols (unique-symbols forms)) - - (when module - (awhen (find (lambda (module) - (equal? target-module - (module-name module))) - (module-uses module)) - (let ((module-symbols (module-map (lambda (key value) key) it))) - ;; (display " ") - (map (lambda (symb) - (cons file symb)) - (lset-intersection eq? source-symbols module-symbols)) - ))) - ) + (catch #t + (lambda () + (define forms (call-with-input-file file get-forms)) + (define module (and=> (-> forms find-module-declaration) resolve-module)) + (define source-symbols (unique-symbols forms)) + + (when module + (awhen (find (lambda (module) + (equal? target-module + (module-name module))) + (module-uses module)) + (let ((module-symbols (module-map (lambda (key value) key) it))) + ;; (display " ") + (map (lambda (symb) + (cons file symb)) + (lset-intersection eq? source-symbols module-symbols)) + )))) + ;; TODO many of these errors are due to the 'prefix and 'postfix + ;; read options being set for modules which expect them to be off. + (lambda (err proc fmt args data) + (format (current-error-port) + "ERROR when reading ~a: ~a in ~a: ~?~%" file err proc fmt args) + '()))) + (delete target-file - (filter (filename-extension? ".scm") + (filter (filename-extension? "scm") (filter regular-file? - (find-all-files-under module-dir))))))) + (append-map (lambda (module-dir) + (find-all-files-under module-dir)) + %load-path))))))) (define file-uses (make-hash-table)) |