Move all generally usable scripts to module dir.

10 files changed, 45 insertions, 250 deletions

diff --git a/scripts/module-introspection.scm b/module/hnh/module-introspection.scm
index ba455cfc..83e561f1 100644
--- a/scripts/module-introspection.scm
+++ b/module/hnh/module-introspection.scm
@@ -1,4 +1,4 @@
-(define-module (module-introspection)
+(define-module (hnh module-introspection)
   :use-module (srfi srfi-1)
   :use-module (hnh util)
   :export (unique-symbols
diff --git a/scripts/all-modules.scm b/module/hnh/module-introspection/all-modules.scm
index 23bbb32d..1bf39e1e 100644
--- a/scripts/all-modules.scm
+++ b/module/hnh/module-introspection/all-modules.scm
@@ -1,11 +1,11 @@
-(define-module (all-modules)
+(define-module (hnh module-introspection 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))
+  :use-module (hnh module-introspection)
+  :use-module ((hnh module-introspection static-util) :select (get-forms))
   :export (all-files-and-modules-under-directory
            all-modules-under-directory
            fs-find-base fs-find
diff --git a/scripts/module-uses.scm b/module/hnh/module-introspection/module-uses.scm
index 220843b6..d690f1d7 100644
--- a/scripts/module-uses.scm
+++ b/module/hnh/module-introspection/module-uses.scm
@@ -1,4 +1,4 @@
-(define-module (module-uses)
+(define-module (hnh module-introspection module-uses)
   :use-module (ice-9 match)
   :export (module-uses*))
 
diff --git a/scripts/static-util.scm b/module/hnh/module-introspection/static-util.scm
index 7aa3626e..7593ce3c 100644
--- a/scripts/static-util.scm
+++ b/module/hnh/module-introspection/static-util.scm
@@ -1,4 +1,4 @@
-(define-module (static-util)
+(define-module (hnh module-introspection static-util)
   :export (get-forms))
 
 (define (get-forms port)
diff --git a/scripts/module-dependants.scm b/module/scripts/module-dependants.scm
index 2880446c..630da519 100755
--- 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,26 +5,22 @@ 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)))
+(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 (texinfo string-utils)
+  :use-module (hnh module-introspection)
+  :use-module ((hnh module-introspection static-util) :select (get-forms))
+  :export (main))
 
-
-(use-modules (hnh util)
-             (hnh util path)
-             (srfi srfi-1)
-             (srfi srfi-71)
-             (ice-9 ftw)
-             (texinfo string-utils)
-             (module-introspection)
-             ((static-util) :select (get-forms)))
+(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?
@@ -62,8 +52,8 @@ exec $GUILE -e main -s "$0" "$@"
     (lambda (filename) (regexp-exec re 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
@@ -93,7 +83,13 @@ exec $GUILE -e main -s "$0" "$@"
          (delete target-file
                  (filter (filename-extension? ".scm")
                          (filter regular-file?
-                                 (find-all-files-under module-dir)))))))
+                                 (append-map (lambda (module-dir)
+                                               (find-all-files-under module-dir))
+                                             ;; TODO this should be %load-path, but get-forms claims
+                                             ;;      some files contains invalid syntax.
+                                             #; %load-path
+                                             '("module")
+                                             )))))))
 
 
   (define file-uses (make-hash-table))
diff --git a/scripts/module-imports.scm b/module/scripts/module-imports.scm
index b7589950..0639715f 100755
--- a/scripts/module-imports.scm
+++ b/module/scripts/module-imports.scm
@@ -1,7 +1,3 @@
-#!/usr/bin/guile \
--e main -s
-!#
-
 ;;; Commentary:
 ;;;
 ;;; Scripts which finds unused imports in each file.
@@ -11,22 +7,24 @@
 ;;;
 ;;; Code:
 
-(add-to-load-path (string-append (dirname (dirname (current-filename))) "/module"))
-(add-to-load-path (dirname (current-filename)))
-
-(use-modules ((srfi srfi-1) :select (lset-difference))
-             ((rnrs lists) :select (remp filter partition))
-             ((module-introspection) :select (module-declaration? unique-symbols))
-             ((static-util) :select (get-forms))
-             ((module-uses) :select (module-uses*))
-             )
+(define-module (scripts module-imports)
+  :use-module ((srfi srfi-1) :select (lset-difference))
+  :use-module ((rnrs lists) :select (remp filter partition))
+  :use-module ((hnh module-introspection) :select (module-declaration? unique-symbols))
+  :use-module ((hnh module-introspection static-util) :select (get-forms))
+  :use-module ((hnh module-introspection module-uses) :select (module-uses*))
+  :export (main)
+  )
 
+;; (define %summary "")
+(define %include-in-guild-list #t)
+(define %synopsis "module-imports filename")
 
 ;;; Module use high scores
 ;;; $ grep -Ho '#\?:use-module' -R module | uniq -c | sort -n
 
-(define (main args)
-  (define filename (cadr args))
+(define (main . args)
+  (define filename (car args))
   (define-values (module-declaration-list forms)
     (partition module-declaration?
                (reverse (call-with-input-file filename get-forms))))
diff --git a/scripts/get-config.scm b/scripts/get-config.scm
index 2409cfc9..99204941 100755
--- a/scripts/get-config.scm
+++ b/scripts/get-config.scm
@@ -8,8 +8,7 @@
 ;;; Code:
 
 
-(add-to-load-path "module")
-(add-to-load-path "scripts")
+(add-to-load-path (string-append (dirname (dirname (current-filename))) "/module"))
 
 (use-modules
   (hnh util)
@@ -18,9 +17,9 @@
   (srfi srfi-1)
   (srfi srfi-88)
 
-  (all-modules)
-  (module-introspection)
-  ((static-util)
+  (hnh module-introspection all-modules)
+  (hnh module-introspection module-introspection)
+  ((hnh module-introspection static-util)
    :select (get-forms))
 
   ((calp translation)
diff --git a/scripts/input.scm b/scripts/input.scm
index 3589a45a..626f5346 100755
--- a/scripts/input.scm
+++ b/scripts/input.scm
@@ -6,7 +6,7 @@
 ;;; `c' to clear screen, `q' to quit.
 ;;; Code:
 
-(add-to-load-path "module")
+(add-to-load-path (string-append (dirname (dirname (current-filename))) "/module"))
 (use-modules (vulgar))
 
 (define chrlist '())
diff --git a/scripts/peg-to-graph.scm b/scripts/peg-to-graph.scm
deleted file mode 100755
index 09a36f06..00000000
--- a/scripts/peg-to-graph.scm
+++ /dev/null
@@ -1,57 +0,0 @@
-#!/usr/bin/env bash
-GUILE=${GUILE:-guile}
-set -x
-exec $GUILE -e main -s "$0" "$@"
-!#
-
-(add-to-load-path (dirname (current-filename)))
-(add-to-load-path (string-append (dirname (current-filename)) "/use2dot"))
-
-
-(use-modules ((graphviz) :prefix #{gv:}#)
-             ((module-introspection) :select (unique-symbols))
-             ((static-util) :select (get-forms))
-             (srfi srfi-1)
-             (ice-9 match))
-
-(define peg-primitives
-  '(and or * + ? followed-by not-followed-by peg-any range
-        ignore capture peg))
-
-(define graph (gv:digraph "G"))
-
-(define (handle-peg-form form)
-  (match form
-    (`(define-peg-pattern ,name ,capture ,body)
-     (let ((node (gv:node graph (format #f "~a" name))))
-       (gv:setv node "style"
-                (case capture
-                  ((all) "solid")
-                  ((body) "dashed")
-                  ((none) "dotted"))))
-     (for-each (lambda (symbol)
-                 (gv:edge graph
-                          (format #f "~a" name)
-                          (format #f "~a" symbol)))
-               (remove (lambda (x) (memv x peg-primitives))
-                (unique-symbols (list body)))))))
-
-(define (main args)
-  (when (< 2 (length args))
-    (format #t "Usage: ~a <filename>~%" (car args))
-    (exit 1))
-
-  (let ((input-file (cadr args)))
-    (for-each handle-peg-form
-     (filter (lambda (x)
-               (and (list? x)
-                    (not (null? x))
-                    (eq? 'define-peg-pattern (car x))))
-             (call-with-input-file input-file get-forms))))
-
-  (gv:layout graph "dot")
-  (gv:render graph "pdf" "lex2.pdf")
-
-  (display "done\n"))
-
-
diff --git a/scripts/use2dot/gen-use.scm b/scripts/use2dot/gen-use.scm
deleted file mode 100755
index 6c621fdd..00000000
--- a/scripts/use2dot/gen-use.scm
+++ /dev/null
@@ -1,141 +0,0 @@
-#!/usr/bin/guile -s
-!#
-
-(add-to-load-path (dirname (current-filename)))
-(add-to-load-path (dirname (dirname (current-filename))))
-
-(use-modules ((scripts frisk) :select (make-frisker edge-type edge-up
-                              edge-down))
-             (srfi srfi-1)
-             ((graphviz) :prefix gv.)
-             (all-modules)
-             )
-
-(define scan (make-frisker `(default-module . (calp main))))
-
-(define-values (files our-modules)
-  (all-modules-under-directory "module"))
-
-(define graph (gv.digraph "G"))
-(gv.setv graph "color" "blue")
-(gv.setv graph "compound" "true")
-(gv.setv graph "overlap" "prism")
-;; (gv.setv graph "bgcolor" "blue")
-
-(define count 0)
-
-(define colors
-  '("red" "green" "blue"))
-
-(define rem our-modules)
-
-;; (for-each (lambda (key)
-;; 
-;;             (define subgraph (gv.graph graph (format #f "cluster_~a" count)))
-;; 
-;;             (define-values (use rem*) (partition (lambda (mod) (eq? key (car mod))) rem))
-;;             (set! rem rem*)
-;; 
-;;             ;; (gv.setv subgraph "rankdir" "TB")
-;;             (gv.setv subgraph "color" (list-ref colors count))
-;; 
-;;             (for-each (lambda (name)
-;;                         (gv.node subgraph (format #f "~a" name)))
-;;                       use)
-;; 
-;;             (set! count (1+ count))
-;;             )
-;;           '(calp vcomponent))
-
-;; (define subgraph (gv.graph graph (format #f "cluster_~a" count)))
-;; 
-;; ;; (gv.setv subgraph "rankdir" "TB")
-;; (gv.setv subgraph "color" (list-ref colors count))
-;; 
-;; (for-each (lambda (name)
-;;             (gv.node subgraph (format #f "~a" name)))
-;;           rem)
-
-(define subgraph (gv.graph graph (format #f "cluster_~a" 0)))
-
-;; (gv.setv subgraph "rankdir" "TB")
-(gv.setv subgraph "color" "Red")
-
-(define subgraphs (make-hash-table))
-
-(for-each (lambda (name)
-            (let ((g (hashq-ref subgraphs (car name)
-                                (gv.graph graph (format #f "cluster_~a" (car name))))))
-              (hashq-set! subgraphs (car name) g)
-
-              (let ((node (gv.node g (format #f "~a" name))))
-                (gv.setv node "fillcolor" "green")
-                (gv.setv node "style" "filled")
-                ))
-            )
-          (remove (lambda (x) (eq? 'calp (car x)))
-                  our-modules))
-
-
-(define calp-base (gv.graph graph "cluster_1"))
-(define calpgraphs (make-hash-table))
-
-(for-each (lambda (name)
-            (let ((g (hashq-ref calpgraphs (cadr name)
-                                (gv.graph 
-                                  ;; calp-base 
-                                  graph
-                                  (format #f "cluster_~a" (cadr name))))))
-              (hashq-set! calpgraphs (car name) g)
-
-              (let ((node (gv.node g (format #f "~a" name))))
-                (gv.setv node "fillcolor" "green")
-                (gv.setv node "style" "filled")
-                ))
-            )
-          (remove (compose null? cdr)
-                  (filter (lambda (x) (eq? 'calp (car x)))
-                          our-modules)))
-
-
-(define (remove-edges blacklist edges)
-  (remove (lambda (edge)
-            (or (member (edge-up edge) blacklist)
-                (member (edge-down edge) blacklist)))
-          edges))
-
-
-
-
-
-(for-each (lambda (edge)
-            (let ((gv-edge (gv.edge graph
-                                 (format #f "~a" (edge-down edge))
-                                 (format #f "~a" (edge-up edge))
-                                 )))
-              (when (and (eq? 'calp (car (edge-up edge)))
-                         (not (eq? 'calp (car (edge-down edge)))))
-                (gv.setv gv-edge "color" "red"))
-              (when (and (memv (car (edge-up edge)) '(vcomponent calp))
-                         (not (memv (car (edge-down edge)) '(vcomponent calp ))))
-                (gv.setv gv-edge "color" "blue"))
-              ))
-          (remove-edges '((srfi srfi-1)
-                          (srfi srfi-9)
-                          (srfi srfi-26)
-                          (srfi srfi-41)
-
-                          (ice-9 match)
-                          (ice-9 format)
-
-                          (datetime)
-                          (vcomponent)
-                          (hnh util)
-                          )
-                        ((scan files) 'edges)))
-
-(gv.layout graph "fdp")
-(gv.render graph "pdf" "graph.pdf")
-
-
-(display "done\n")