[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
executable module: module-fan-in.scm
From: |
Thien-Thi Nguyen |
Subject: |
executable module: module-fan-in.scm |
Date: |
Sun, 03 Aug 2003 21:06:52 +0200 |
this is used by scm2bin.scm 1.1 (to be posted shortly), and will
probably make it into guile 1.4.2. (now i challenge someone to write
the analogous module-fan-out program. ;-)
btw, finally got the hdd in storage since february into an accomodating
drive bay, so www.glug.org will be resuming updates in a few days.
patches welcome, of course.
thi
_______________________________________________________
#!/bin/sh
# aside from this initial boilerplate, this is actually -*- scheme -*- code
main='(module-ref (resolve-module '\''(module-fan-in)) '\'main')'
exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
!#
;;; module-fan-in --- Recursively enumerate all upstreams of a module
;; Copyright (C) 2003 Thien-Thi Nguyen
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this software; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;; Boston, MA 02111-1307 USA
;;; Commentary:
;; Usage: module-fan-in [OPTIONS] MODULE
;;
;; Display all upstream modules of MODULE, one per line.
;; MODULE can be a filename or a module name (list of symbols).
;; Normally, modules are displayed starting with the "most close",
;; with the format:
;;
;; DISTANCE MODULE-NAME FILENAME
;;
;; FILENAME can be #f for "pre-loaded modules", like `(guile)'
;; or `(guile-user)', for which a filename does not make sense.
;; OPTIONS is zero or more of:
;;
;; -r, --reverse -- start with most remote instead of most close
;; -d, --no-distance -- omit display of the distance
;; -m, --no-module-name -- omit display of the module name (list of symbols)
;; -f, --no-filename -- omit display of the filename
;;
;; DISTANCE is a number starting with 1 and increasing for every level of
;; indirection. If a module has multiple distances, only the lowest one
;; (closest) is shown.
;;
;;
;; Usage from a Scheme Program:
;; (use-modules (module-fan-in))
;; (module-fan-in NAMES) => SEEN
;;
;; NAMES is a list whose elements are either a module-name (list of symbols)
;; or a filename (string). SEEN is a list of module-names, each with two
;; object properties (symbols):
;;
;; distance -- an integer
;; filename -- a string
;;
;; The order of SEEN is farthest (from NAMES) first.
;;
;;
;; TODO: move `->filename' to (scripts frisk)
;; handle edge types in configurable ways (e.g., omit "autoload")
;;; Code:
(define-module (module-fan-in)
:use-module ((scripts PROGRAM) :select (script-MAIN))
:use-module ((scripts frisk) :select (make-frisker))
:use-module ((srfi srfi-1) :select (filter-map
delete-duplicates
lset-difference))
:export (module-fan-in))
(define put set-object-property!)
(define get object-property)
(define file-frisk (make-frisker))
(define (->filename name)
(let ((rv (cond ((pair? name)
(%search-load-path
(apply string-append
(cons (symbol->string (car name))
(map (lambda (comp)
(string-append
"/" (symbol->string comp)))
(cdr name))))))
((and (string? name)
(file-exists? name))
name)
((and (symbol? name)
(file-exists? (symbol->string name)))
(symbol->string name))
(else #f))))
(put name 'filename rv)
rv))
(define (frisk names)
(file-frisk (filter-map ->filename names)))
(define (module-fan-in names) ; garden variety bfs
(let loop ((todo names)
(seen names)
(distance 1))
(if (null? todo)
seen ; retval order: farthest first
(let ((new (lset-difference equal?
(delete-duplicates
((frisk todo)
;; x-down gives all possible edge types
;; but probably we want to be a bit more
;; discerning (e.g., omit "autoload"),
;; or at least make this configurable
'x-down))
seen)))
(loop new
(append (map (lambda (x)
(put x 'distance distance)
x)
new)
seen)
(1+ distance))))))
(define (module-fan-in/qop qop)
(let ((=r (qop 'reverse))
(=d (qop 'no-distance))
(=m (qop 'no-module-name))
(=f (qop 'no-filename)))
(for-each (lambda (m) ; module
(cond ((get m 'distance)
(or =d (display (get m 'distance)))
(or =m (begin (or =d (display " ")) (display m)))
(or =f (begin (or (and =d =m) (display " "))
(display (get m 'filename))))
(or (and =d =m =f) (newline)))))
((if =r identity reverse)
(module-fan-in (map (lambda (arg)
(with-input-from-string arg read))
(qop '()))))))
#t)
(define (main . args)
(script-MAIN args
"module-fan-in" module-fan-in/qop
'(usage . commentary)
'(option-spec (reverse (single-char #\r))
(no-distance (single-char #\d))
(no-module-name (single-char #\m))
(no-filename (single-char #\f)))))
;;; module-fan-in ends here
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- executable module: module-fan-in.scm,
Thien-Thi Nguyen <=