scripts/autofrisk peek

[Thien-Thi Nguyen]

i'm posting scripts/autofrisk below (work-in-progress) to request
feedback.  to play, see modules.af and modules.af.m4 recently posted to
guile-user, and modify modules.af to taste.  next, put the line:

  AUTOFRISK_CHECKS

in your configure.in, run autofrisk, then run aclocal, then autoconf,
then ./configure.

specific questions i have:
 - should `probably_wont_work' (var name) be parameterized?
 - should that whole mess be omitted?
 - any comments on the partitioning algorithm?  is it sufficient?
 - is the name "autofrisk" dangerous for lonely programmers? :->
 - how should autofrisk also handle non-module deps (e.g., (ttn rcsutils)
   depends on program "rlog")?

(please remove guile-sources from replies.)

thi


_____________________________
#!/bin/sh
# aside from this initial boilerplate, this is actually -*- scheme -*- code
main='(module-ref (resolve-module '\''(scripts autofrisk)) '\'main')'
exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
!#
;;; autofrisk --- Generate module dependencies info for auto* tools

;;      Copyright (C) 2001 Free Software Foundation, Inc.
;;
;; 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

;;; Author: Thien-Thi Nguyen <address@hidden>

;;; Commentary:

;; Usage: autofrisk
;;
;; [todo]
;;
;; TODO:

;;; Code:

(debug-enable 'backtrace 'debug)                ;; here.

(define-module (scripts autofrisk)
  :autoload (ice-9 popen) (open-input-pipe)
  :use-module (srfi srfi-1)
  :use-module (srfi srfi-8)
  :use-module (srfi srfi-13)
  :use-module (srfi srfi-14)
  :use-module (scripts read-scheme-source)
  :use-module (scripts frisk)
  :export (autofrisk))

(define (spew-req module)
  (format #t "GUILE_MODULE_REQUIRED~A\n" module))

(define (->varname module)
  (let ((var (object->string module)))
    (string-map! (lambda (c)
                   (if (char-set-contains? char-set:letter+digit c)
                       c
                       #\_))
                 var)
    var))

(define (spew-avail-1 module)
  (let ((v (string-append "have_guile_module" (->varname module))))
    (format #t "GUILE_MODULE_AVAILABLE(~A, ~A)\n" v module)
    v))

(define (spew-avail weak-edges)
  (let* ((pww "probably_wont_work"))
    (format #t "\n~A=~S\n\n" pww "")
    (for-each (lambda (edge)
                (let* ((up (edge-up edge))
                       (down (edge-down edge))
                       (varname (spew-avail-1 up)))
                  (format #t "test \"$~A\" = no &&\n  ~A=\"~A $~A\"~A"
                          varname pww down pww "\n\n")))
              weak-edges)
    (format #t "if test ! \"$~A\" = \"\" ; then\n" pww)
    (format #t "    echo \"These modules probably won't work:\"\n")
    (format #t "    echo \"  $~A\"\n" pww)
    (format #t "fi\n")))

(define *recognized-keys* '(files
                            files-glob
                            non-critical-external
                            non-critical-internal))

(define (validate forms)
  (or (and (list? forms)
           (every list? forms)
           (every (lambda (form)
                    (let ((key (car form)))
                      (and (symbol? key)
                           (or (eq? 'quote key)
                               (memq key *recognized-keys*)))))
                  forms))
      (error "syntax error"))
  (let ((w/o-quotes (remove (lambda (form)       ;;; ugly here.
                              (eq? (car form) 'quote))
                            forms)))
    (lambda (key)
      (assq-ref w/o-quotes key))))

(define (unglob pattern)
  (let ((p (open-input-pipe (format #f "echo '(' ~A ')'" pattern))))
    (map symbol->string (read p))))

(define (>>ac forms)            ; smash here.
  (let* ((cfg (validate forms))
         (files (apply append (map unglob (cfg 'files-glob))))
         (ncx (or (cfg 'non-critical-external) (list)))
         (nci (or (cfg 'non-critical-internal) (list)))
         (report ((make-frisker) files))
         (external (report 'external)))
    (receive (weak strong)
        (partition (lambda (module)
                     (or (member module ncx)
                         (every (lambda (i)
                                  (member i nci))
                                (map edge-down (mod-down-ls module)))))
                   external)
      (format #t "AC_DEFUN([AUTOFRISK_CHECKS],[\n\n")
      (for-each spew-req strong)
      (spew-avail (fold (lambda (module so-far)
                          (append so-far (mod-down-ls module))) 
                        (list)
                        weak))
      (format #t "\n])\n"))))

(define (autofrisk . args)
  ;; options here.
  (or (file-exists? "modules.af")
      (error "no inupt file"))
  (with-output-to-file "modules.af.m4"
    (lambda ()
      (>>ac (read-scheme-source-silently "modules.af")))))

(define main autofrisk)

;; Local variables:
;; eval: (put 'receive 'scheme-indent-function 2)
;; End:

;;; autofrisk ends here